GCC Code Coverage Report


Directory: ./
File: gfsphysics/physics/sfcsub.F
Date: 2021-06-18 17:08:19
Exec Total Coverage
Lines: 2351 4096 57.4%
Branches: 4510 12208 36.9%

Line Branch Exec Source
1 module sfccyc_module
2 implicit none
3 save
4 !
5 ! grib code for each parameter - used in subroutines sfccycle and setrmsk.
6 !
7 integer kpdtsf,kpdwet,kpdsno,kpdzor,kpdais,kpdtg3,kpdplr,kpdgla,
8 & kpdmxi,kpdscv,kpdsmc,kpdoro,kpdmsk,kpdstc,kpdacn,kpdveg,
9 & kpdvet,kpdsot
10 &, kpdvmn,kpdvmx,kpdslp,kpdabs
11 &, kpdsnd, kpdabs_0, kpdabs_1, kpdalb(4)
12 parameter(kpdtsf=11, kpdwet=86, kpdsno=65, kpdzor=83,
13 ! 1 kpdalb=84, kpdais=91, kpdtg3=11, kpdplr=224,
14 1 kpdais=91, kpdtg3=11, kpdplr=224,
15 2 kpdgla=238, kpdmxi=91, kpdscv=238, kpdsmc=144,
16 3 kpdoro=8, kpdmsk=81, kpdstc=11, kpdacn=91, kpdveg=87,
17 !cbosu max snow albedo uses a grib id number of 159, not 255.
18 & kpdvmn=255, kpdvmx=255,kpdslp=236, kpdabs_0=255,
19 & kpdvet=225, kpdsot=224,kpdabs_1=159,
20 & kpdsnd=66 )
21 !
22 integer, parameter :: kpdalb_0(4)=(/212,215,213,216/)
23 integer, parameter :: kpdalb_1(4)=(/189,190,191,192/)
24 integer, parameter :: kpdalf(2)=(/214,217/)
25 !
26 integer, parameter :: xdata=5000, ydata=2500, mdata=xdata*ydata
27 integer :: veg_type_landice
28 integer :: soil_type_landice
29 !
30 end module sfccyc_module
31 12 subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc
32 &, iy,im,id,ih,fh
33 12 &, rla, rlo, slmask,orog,orog_uf,use_ufo,nst_anl
34 18 &, sihfcs,sicfcs,sitfcs
35 12 &, swdfcs,slcfcs
36 6 &, vmnfcs,vmxfcs,slpfcs,absfcs
37 6 &, tsffcs,snofcs,zorfcs,albfcs,tg3fcs
38 6 &, cnpfcs,smcfcs,stcfcs,slifcs,aisfcs
39 6 &, vegfcs,vetfcs,sotfcs,alffcs
40 6 &, cvfcs,cvbfcs,cvtfcs,me,nlunit
41 6 &, sz_nml,input_nml_file
42 6 &, ialb,isot,ivegsrc,tile_num_ch,i_index,j_index
43 &, sst_perturbation)
44 !
45 use machine , only : kind_io8,kind_io4
46 use sfccyc_module
47 implicit none
48 character(len=*), intent(in) :: tile_num_ch
49 integer,intent(in) :: i_index(len), j_index(len)
50 logical use_ufo, nst_anl
51 real (kind=kind_io8) sllnd,slsea,aicice,aicsea,tgice,rlapse,
52 & orolmx,orolmn,oroomx,oroomn,orosmx,
53 & orosmn,oroimx,oroimn,orojmx,orojmn,
54 12 & alblmx,alblmn,albomx,albomn,albsmx,
55 6 & albsmn,albimx,albimn,albjmx,albjmn,
56 & wetlmx,wetlmn,wetomx,wetomn,wetsmx,
57 & wetsmn,wetimx,wetimn,wetjmx,wetjmn,
58 & snolmx,snolmn,snoomx,snoomn,snosmx,
59 & snosmn,snoimx,snoimn,snojmx,snojmn,
60 & zorlmx,zorlmn,zoromx,zoromn,zorsmx,
61 & zorsmn,zorimx,zorimn,zorjmx, zorjmn,
62 & plrlmx,plrlmn,plromx,plromn,plrsmx,
63 & plrsmn,plrimx,plrimn,plrjmx,plrjmn,
64 & tsflmx,tsflmn,tsfomx,tsfomn,tsfsmx,
65 & tsfsmn,tsfimx,tsfimn,tsfjmx,tsfjmn,
66 & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3smx,
67 & tg3smn,tg3imx,tg3imn,tg3jmx,tg3jmn,
68 & stclmx,stclmn,stcomx,stcomn,stcsmx,
69 & stcsmn,stcimx,stcimn,stcjmx,stcjmn,
70 & smclmx,smclmn,smcomx,smcomn,smcsmx,
71 & smcsmn,smcimx,smcimn,smcjmx,smcjmn,
72 & scvlmx,scvlmn,scvomx,scvomn,scvsmx,
73 & scvsmn,scvimx,scvimn,scvjmx,scvjmn,
74 & veglmx,veglmn,vegomx,vegomn,vegsmx,
75 & vegsmn,vegimx,vegimn,vegjmx,vegjmn,
76 & vetlmx,vetlmn,vetomx,vetomn,vetsmx,
77 & vetsmn,vetimx,vetimn,vetjmx,vetjmn,
78 & sotlmx,sotlmn,sotomx,sotomn,sotsmx,
79 & sotsmn,sotimx,sotimn,sotjmx,sotjmn,
80 & alslmx,alslmn,alsomx,alsomn,alssmx,
81 & alssmn,alsimx,alsimn,alsjmx,alsjmn,
82 & epstsf,epsalb,epssno,epswet,epszor,
83 & epsplr,epsoro,epssmc,epsscv,eptsfc,
84 & epstg3,epsais,epsacn,epsveg,epsvet,
85 & epssot,epsalf,qctsfs,qcsnos,qctsfi,
86 & aislim,snwmin,snwmax,cplrl,cplrs,
87 & cvegl,czors,csnol,csnos,czorl,csots,
88 & csotl,cvwgs,cvetl,cvets,calfs,
89 & fcalfl,fcalfs,ccvt,ccnp,ccv,ccvb,
90 & calbl,calfl,calbs,ctsfs,grboro,
91 6 & grbmsk,ctsfl,deltf,caisl,caiss,
92 & fsalfl,fsalfs,flalfs,falbl,ftsfl,
93 & ftsfs,fzorl,fzors,fplrl,fsnos,faisl,
94 6 & faiss,fsnol,bltmsk,falbs,cvegs,percrit,
95 & deltsfc,critp2,critp3,blnmsk,critp1,
96 & fcplrl,fcplrs,fczors,fvets,fsotl,fsots,
97 & fvetl,fplrs,fvegl,fvegs,fcsnol,fcsnos,
98 & fczorl,fcalbs,fctsfl,fctsfs,fcalbl,
99 12 & falfs,falfl,fh,crit,zsca,ztsfc,tem1,tem2
100 &, fsihl,fsihs,fsicl,fsics,
101 & csihl,csihs,csicl,csics,epssih,epssic
102 &, fvmnl,fvmns,fvmxl,fvmxs,fslpl,fslps,
103 & fabsl,fabss,cvmnl,cvmns,cvmxl,cvmxs,
104 & cslpl,cslps,cabsl,cabss,epsvmn,epsvmx,
105 & epsslp,epsabs
106 &, sihlmx,sihlmn,sihomx,sihomn,sihsmx,
107 & sihsmn,sihimx,sihimn,sihjmx,sihjmn,
108 & siclmx,siclmn,sicomx,sicomn,sicsmx,
109 & sicsmn,sicimx,sicimn,sicjmx,sicjmn
110 &, glacir_hice
111 &, vmnlmx,vmnlmn,vmnomx,vmnomn,vmnsmx,
112 & vmnsmn,vmnimx,vmnimn,vmnjmx,vmnjmn,
113 & vmxlmx,vmxlmn,vmxomx,vmxomn,vmxsmx,
114 & vmxsmn,vmximx,vmximn,vmxjmx,vmxjmn,
115 & slplmx,slplmn,slpomx,slpomn,slpsmx,
116 & slpsmn,slpimx,slpimn,slpjmx,slpjmn,
117 12 & abslmx,abslmn,absomx,absomn,abssmx,
118 6 & abssmn,absimx,absimn,absjmx,absjmn
119 &, sihnew
120
121 24 integer imsk,jmsk,ifp,irtscv,irtacn,irtais,irtsno,irtzor,
122 30 & irtalb,irtsot,irtalf,j,irtvet,irtsmc,irtstc,irtveg,
123 30 & irtwet,k,iprnt,kk,irttsf,iret,i,igrdbg,iy,im,id,
124 & icalbl,icalbs,icalfl,ictsfs,lugb,len,lsoil,ih,
125 & ictsfl,iczors,icplrl,icplrs,iczorl,icalfs,icsnol,
126 12 & icsnos,irttg3,me,kqcm,nlunit,sz_nml,ialb
127 18 &, irtvmn, irtvmx, irtslp, irtabs, isot, ivegsrc
128 logical gausm, deads, qcmsk, znlst, monclm, monanl,
129 & monfcs, monmer, mondif, landice
130 character(len=*), intent(in) :: input_nml_file(sz_nml)
131
132 integer num_parthds
133 !
134 ! this is a limited point version of surface program.
135 !
136 ! this program runs in two different modes:
137 !
138 ! 1. analysis mode (fh=0.)
139 !
140 ! this program merges climatology, analysis and forecast guess to create
141 ! new surface fields. if analysis file is given, the program
142 ! uses it if date of the analysis matches with iy,im,id,ih (see note
143 ! below).
144 !
145 ! 2. forecast mode (fh.gt.0.)
146 !
147 ! this program interpolates climatology to the date corresponding to the
148 ! forecast hour. if surface analysis file is given, for the corresponding
149 ! dates, the program will use it.
150 !
151 ! note:
152 !
153 ! if the date of the analysis does not match given iy,im,id,ih, (and fh),
154 ! the program searches an old analysis by going back 6 hours, then 12 hours,
155 ! then one day upto nrepmx days (parameter statement in the subrotine fixrd.
156 ! now defined as 8). this allows the user to provide non-daily analysis to
157 ! be used. if matching field is not found, the forecast guess will be used.
158 !
159 ! use of a combined earlier surface analyses and current analysis is
160 ! not allowed (as was done in the old version for snow analysis in which
161 ! old snow analysis is used in combination with initial guess), except
162 ! for sea surface temperature. for sst anolmaly interpolation, you need to
163 ! set lanom=.true. and must provide sst analysis at initial time.
164 !
165 ! if you want to do complex merging of past and present surface field analysis,
166 ! you need to create a separate file that contains daily surface field.
167 !
168 ! for a dead start, do not supply fnbgsi or set fnbgsi=' '
169 !
170 ! lugb is the unit number used in this subprogram
171 ! len ... number of points on which sfccyc operates
172 ! lsoil .. number of soil layers (2 as of april, 1994)
173 ! iy,im,id,ih .. year, month, day, and hour of initial state.
174 ! fh .. forecast hour
175 ! rla, rlo -- latitude and longitudes of the len points
176 ! sig1t .. sigma level 1 temperature for dead start. should be on gaussian
177 ! grid. if not dead start, no need for dimension but set to zero
178 ! as in the example below.
179 !
180 ! variable naming conventions:
181 !
182 ! oro .. orography
183 ! alb .. albedo
184 ! wet .. soil wetness as defined for bucket model
185 ! sno .. snow depth
186 ! zor .. surface roughness length
187 ! vet .. vegetation type
188 ! plr .. plant evaporation resistance
189 ! tsf .. surface skin temperature. sea surface temp. over ocean.
190 ! tg3 .. deep soil temperature (at 500cm)
191 ! stc .. soil temperature (lsoil layrs)
192 ! smc .. soil moisture (lsoil layrs)
193 ! scv .. snow cover (not snow depth)
194 ! ais .. sea ice mask (0 or 1)
195 ! acn .. sea ice concentration (fraction)
196 ! gla .. glacier (permanent snow) mask (0 or 1)
197 ! mxi .. maximum sea ice extent (0 or 1)
198 ! msk .. land ocean mask (0=ocean 1=land)
199 ! cnp .. canopy water content
200 ! cv .. convective cloud cover
201 ! cvb .. convective cloud base
202 ! cvt .. convective cloud top
203 ! sli .. land/sea/sea-ice mask. (1/0/2 respectively)
204 ! veg .. vegetation cover
205 ! sot .. soil type
206 !cwu [+2l] add sih & sic
207 ! sih .. sea ice thickness
208 ! sic .. sea ice concentration
209 !clu [+6l] add swd,slc,vmn,vmx,slp,abs
210 ! swd .. actual snow depth
211 ! slc .. liquid soil moisture (lsoil layers)
212 ! vmn .. vegetation cover minimum
213 ! vmx .. vegetation cover maximum
214 ! slp .. slope type
215 ! abs .. maximum snow albedo
216
217 !
218 ! definition of land/sea mask. sllnd for land and slsea for sea.
219 ! definition of sea/ice mask. aicice for ice, aicsea for sea.
220 ! tgice=max ice temperature
221 ! rlapse=lapse rate for sst correction due to surface angulation
222 !
223 parameter(sllnd =1.0,slsea =0.0)
224 parameter(aicice=1.0,aicsea=0.0)
225 parameter(tgice=271.2)
226 parameter(rlapse=0.65e-2)
227 !
228 ! max/min of fields for check and replace.
229 !
230 ! ???lmx .. max over bare land
231 ! ???lmn .. min over bare land
232 ! ???omx .. max over open ocean
233 ! ???omn .. min over open ocean
234 ! ???smx .. max over snow surface (land and sea-ice)
235 ! ???smn .. min over snow surface (land and sea-ice)
236 ! ???imx .. max over bare sea ice
237 ! ???imn .. min over bare sea ice
238 ! ???jmx .. max over snow covered sea ice
239 ! ???jmn .. min over snow covered sea ice
240 !
241 parameter(orolmx=8000.,orolmn=-1000.,oroomx=3000.,oroomn=-1000.,
242 & orosmx=8000.,orosmn=-1000.,oroimx=3000.,oroimn=-1000.,
243 & orojmx=3000.,orojmn=-1000.)
244 ! parameter(alblmx=0.80,alblmn=0.06,albomx=0.06,albomn=0.06,
245 ! & albsmx=0.80,albsmn=0.06,albimx=0.80,albimn=0.80,
246 ! & albjmx=0.80,albjmn=0.80)
247 !cwu [-3l/+9l] change min/max for alb; add min/max for sih & sic
248 ! parameter(alblmx=0.80,alblmn=0.01,albomx=0.01,albomn=0.01,
249 ! & albsmx=0.80,albsmn=0.01,albimx=0.01,albimn=0.01,
250 ! & albjmx=0.01,albjmn=0.01)
251 ! note: the range values for bare land and snow covered land
252 ! (alblmx, alblmn, albsmx, albsmn) are set below
253 ! based on whether the old or new radiation is selected
254 parameter(albomx=0.06,albomn=0.06,
255 & albimx=0.80,albimn=0.06,
256 & albjmx=0.80,albjmn=0.06)
257 parameter(sihlmx=0.0,sihlmn=0.0,sihomx=5.0,sihomn=0.0,
258 & sihsmx=5.0,sihsmn=0.0,sihimx=5.0,sihimn=0.10,
259 & sihjmx=5.0,sihjmn=0.10,glacir_hice=3.0)
260 !cwu change sicimn & sicjmn Jan 2015
261 ! parameter(siclmx=0.0,siclmn=0.0,sicomx=1.0,sicomn=0.0,
262 ! & sicsmx=1.0,sicsmn=0.0,sicimx=1.0,sicimn=0.50,
263 ! & sicjmx=1.0,sicjmn=0.50)
264 !
265 ! parameter(sihlmx=0.0,sihlmn=0.0,sihomx=8.0,sihomn=0.0,
266 ! & sihsmx=8.0,sihsmn=0.0,sihimx=8.0,sihimn=0.10,
267 ! & sihjmx=8.0,sihjmn=0.10,glacir_hice=3.0)
268 parameter(siclmx=0.0,siclmn=0.0,sicomx=1.0,sicomn=0.0,
269 & sicsmx=1.0,sicsmn=0.0,sicimx=1.0,sicimn=0.15,
270 & sicjmx=1.0,sicjmn=0.15)
271
272 parameter(wetlmx=0.15,wetlmn=0.00,wetomx=0.15,wetomn=0.15,
273 & wetsmx=0.15,wetsmn=0.15,wetimx=0.15,wetimn=0.15,
274 & wetjmx=0.15,wetjmn=0.15)
275 parameter(snolmx=0.0,snolmn=0.0,snoomx=0.0,snoomn=0.0,
276 & snosmx=55000.,snosmn=0.001,snoimx=0.,snoimn=0.0,
277 & snojmx=10000.,snojmn=0.01)
278 parameter(zorlmx=300.,zorlmn=1.0,zoromx=1.0,zoromn=1.e-05,
279 & zorsmx=300.,zorsmn=1.0,zorimx=1.0,zorimn=1.0,
280 & zorjmx=1.0,zorjmn=1.0)
281 parameter(plrlmx=1000.,plrlmn=0.0,plromx=1000.0,plromn=0.0,
282 & plrsmx=1000.,plrsmn=0.0,plrimx=1000.,plrimn=0.0,
283 & plrjmx=1000.,plrjmn=0.0)
284 !clu [-1l/+1l] relax tsfsmx (for noah lsm)
285 parameter(tsflmx=353.,tsflmn=173.0,tsfomx=313.0,tsfomn=271.2,
286 & tsfsmx=305.0,tsfsmn=173.0,tsfimx=271.2,tsfimn=173.0,
287 & tsfjmx=273.16,tsfjmn=173.0)
288 ! parameter(tsflmx=353.,tsflmn=173.0,tsfomx=313.0,tsfomn=271.21,
289 !* & tsfsmx=273.16,tsfsmn=173.0,tsfimx=271.21,tsfimn=173.0,
290 ! & tsfsmx=305.0,tsfsmn=173.0,tsfimx=271.21,tsfimn=173.0,
291 parameter(tg3lmx=310.,tg3lmn=200.0,tg3omx=310.0,tg3omn=200.0,
292 & tg3smx=310.,tg3smn=200.0,tg3imx=310.0,tg3imn=200.0,
293 & tg3jmx=310.,tg3jmn=200.0)
294 parameter(stclmx=353.,stclmn=173.0,stcomx=313.0,stcomn=200.0,
295 & stcsmx=310.,stcsmn=200.0,stcimx=310.0,stcimn=200.0,
296 & stcjmx=310.,stcjmn=200.0)
297 !landice mods force a flag value of soil moisture of 1.0
298 ! at non-land points
299 parameter(smclmx=0.55,smclmn=0.0,smcomx=1.0,smcomn=1.0,
300 & smcsmx=0.55,smcsmn=0.0,smcimx=1.0,smcimn=1.0,
301 & smcjmx=1.0,smcjmn=1.0)
302 parameter(scvlmx=0.0,scvlmn=0.0,scvomx=0.0,scvomn=0.0,
303 & scvsmx=1.0,scvsmn=1.0,scvimx=0.0,scvimn=0.0,
304 & scvjmx=1.0,scvjmn=1.0)
305 parameter(veglmx=1.0,veglmn=0.0,vegomx=0.0,vegomn=0.0,
306 & vegsmx=1.0,vegsmn=0.0,vegimx=0.0,vegimn=0.0,
307 & vegjmx=0.0,vegjmn=0.0)
308 parameter(vmnlmx=1.0,vmnlmn=0.0,vmnomx=0.0,vmnomn=0.0,
309 & vmnsmx=1.0,vmnsmn=0.0,vmnimx=0.0,vmnimn=0.0,
310 & vmnjmx=0.0,vmnjmn=0.0)
311 parameter(vmxlmx=1.0,vmxlmn=0.0,vmxomx=0.0,vmxomn=0.0,
312 & vmxsmx=1.0,vmxsmn=0.0,vmximx=0.0,vmximn=0.0,
313 & vmxjmx=0.0,vmxjmn=0.0)
314 parameter(slplmx=9.0,slplmn=1.0,slpomx=0.0,slpomn=0.0,
315 & slpsmx=9.0,slpsmn=1.0,slpimx=0.,slpimn=0.,
316 & slpjmx=0.,slpjmn=0.)
317 ! note: the range values for bare land and snow covered land
318 ! (alblmx, alblmn, albsmx, albsmn) are set below
319 ! based on whether the old or new radiation is selected
320 parameter(absomx=0.0,absomn=0.0,
321 & absimx=0.0,absimn=0.0,
322 & absjmx=0.0,absjmn=0.0)
323 ! vegetation type
324 parameter(vetlmx=20.,vetlmn=1.0,vetomx=0.0,vetomn=0.0,
325 & vetsmx=20.,vetsmn=1.0,vetimx=0.,vetimn=0.,
326 & vetjmx=0.,vetjmn=0.)
327 ! soil type
328 parameter(sotlmx=16.,sotlmn=1.0,sotomx=0.0,sotomn=0.0,
329 & sotsmx=16.,sotsmn=1.0,sotimx=0.,sotimn=0.,
330 & sotjmx=0.,sotjmn=0.)
331 ! fraction of vegetation for strongly and weakly zeneith angle dependent
332 ! albedo
333 parameter(alslmx=1.0,alslmn=0.0,alsomx=0.0,alsomn=0.0,
334 & alssmx=1.0,alssmn=0.0,alsimx=0.0,alsimn=0.0,
335 & alsjmx=0.0,alsjmn=0.0)
336 !
337 ! criteria used for monitoring
338 !
339 parameter(epstsf=0.01,epsalb=0.001,epssno=0.01,
340 & epswet=0.01,epszor=0.0000001,epsplr=1.,epsoro=0.,
341 & epssmc=0.0001,epsscv=0.,eptsfc=0.01,epstg3=0.01,
342 & epsais=0.,epsacn=0.01,epsveg=0.01,
343 & epssih=0.001,epssic=0.001,
344 & epsvmn=0.01,epsvmx=0.01,epsabs=0.001,epsslp=0.01,
345 & epsvet=.01,epssot=.01,epsalf=.001)
346 !
347 ! quality control of analysis snow and sea ice
348 !
349 ! qctsfs .. surface temperature above which no snow allowed
350 ! qcsnos .. snow depth above which snow must exist
351 ! qctsfi .. sst above which sea-ice is not allowed
352 !
353 !clu relax qctsfs (for noah lsm)
354 !* parameter(qctsfs=283.16,qcsnos=100.,qctsfi=280.16)
355 !* parameter(qctsfs=288.16,qcsnos=100.,qctsfi=280.16)
356 parameter(qctsfs=293.16,qcsnos=100.,qctsfi=280.16)
357 !
358 !cwu [-2l]
359 !* ice concentration for ice limit (55 percent)
360 !
361 !* parameter(aislim=0.55)
362 !
363 ! parameters to obtain snow depth from snow cover and temperature
364 !
365 ! parameter(snwmin=25.,snwmax=100.)
366 parameter(snwmin=5.0,snwmax=100.)
367 real (kind=kind_io8), parameter :: ten=10.0, one=1.0
368 !
369 ! coeeficients of blending forecast and interpolated clim
370 ! (or analyzed) fields over sea or land(l) (not for clouds)
371 ! 1.0 = use of forecast
372 ! 0.0 = replace with interpolated analysis
373 !
374 ! these values are set for analysis mode.
375 !
376 ! variables land sea
377 ! ---------------------------------------------------------
378 ! surface temperature forecast analysis
379 ! surface temperature forecast forecast (over sea ice)
380 ! albedo analysis analysis
381 ! sea-ice analysis analysis
382 ! snow analysis forecast (over sea ice)
383 ! roughness analysis forecast
384 ! plant resistance analysis analysis
385 ! soil wetness (layer) weighted average analysis
386 ! soil temperature forecast analysis
387 ! canopy waver content forecast forecast
388 ! convective cloud cover forecast forecast
389 ! convective cloud bottm forecast forecast
390 ! convective cloud top forecast forecast
391 ! vegetation cover analysis analysis
392 ! vegetation type analysis analysis
393 ! soil type analysis analysis
394 ! sea-ice thickness forecast forecast
395 ! sea-ice concentration analysis analysis
396 ! vegetation cover min analysis analysis
397 ! vegetation cover max analysis analysis
398 ! max snow albedo analysis analysis
399 ! slope type analysis analysis
400 ! liquid soil wetness analysis-weighted analysis
401 ! actual snow depth analysis-weighted analysis
402 !
403 ! note: if analysis file is not given, then time interpolated climatology
404 ! is used. if analyiss file is given, it will be used as far as the
405 ! date and time matches. if they do not match, it uses forecast.
406 !
407 ! critical percentage value for aborting bad points when lgchek=.true.
408 !
409 logical lgchek
410 data lgchek/.true./
411 data critp1,critp2,critp3/80.,80.,25./
412 !
413 ! integer kpdalb(4), kpdalf(2)
414 ! data kpdalb/212,215,213,216/, kpdalf/214,217/
415 ! save kpdalb, kpdalf
416 !
417 ! mask orography and variance on gaussian grid
418 !
419 real (kind=kind_io8) slmask(len),orog(len), orog_uf(len)
420
5/8
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
18 &, orogd(len)
421 real (kind=kind_io8) rla(len), rlo(len)
422 !
423 ! permanent/extremes
424 !
425 character*500 fnglac,fnmxic
426 real (kind=kind_io8), allocatable :: glacir(:),amxice(:),tsfcl0(:)
427 !
428 ! tsfcl0 is the climatological tsf at fh=0
429 !
430 ! climatology surface fields (last character 'c' or 'clm' indicate climatology)
431 !
432 character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc,
433 & fnplrc,fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,
434 & fnvegc,fnvetc,fnsotc
435 &, fnvmnc,fnvmxc,fnslpc,fnabsc, fnalbc2
436
15/24
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 13824 times.
✓ Branch 21 taken 6 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 6 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 6 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 6 times.
✓ Branch 31 taken 13824 times.
✓ Branch 32 taken 6 times.
54 real (kind=kind_io8) tsfclm(len), wetclm(len), snoclm(len),
437
17/26
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 24 times.
✓ Branch 21 taken 6 times.
✓ Branch 22 taken 55296 times.
✓ Branch 23 taken 24 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 6 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 6 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 6 times.
✓ Branch 33 taken 13824 times.
✓ Branch 34 taken 6 times.
54 & zorclm(len), albclm(len,4), aisclm(len),
438
15/24
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 13824 times.
✓ Branch 21 taken 6 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 6 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 6 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 6 times.
✓ Branch 31 taken 13824 times.
✓ Branch 32 taken 6 times.
54 & tg3clm(len), acnclm(len), cnpclm(len),
439
15/24
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 13824 times.
✓ Branch 21 taken 6 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 6 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 6 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 6 times.
✓ Branch 31 taken 13824 times.
✓ Branch 32 taken 6 times.
36 & cvclm (len), cvbclm(len), cvtclm(len),
440
15/24
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 13824 times.
✓ Branch 21 taken 6 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 6 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 6 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 6 times.
✓ Branch 31 taken 13824 times.
✓ Branch 32 taken 6 times.
54 & scvclm(len), tsfcl2(len), vegclm(len),
441
22/34
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 13824 times.
✓ Branch 21 taken 6 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 6 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 6 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 6 times.
✓ Branch 31 taken 13824 times.
✓ Branch 32 taken 6 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 6 times.
✗ Branch 36 not taken.
✓ Branch 37 taken 6 times.
✗ Branch 39 not taken.
✓ Branch 40 taken 6 times.
✓ Branch 42 taken 12 times.
✓ Branch 43 taken 6 times.
✓ Branch 44 taken 27648 times.
✓ Branch 45 taken 12 times.
72 & vetclm(len), sotclm(len), alfclm(len,2), sliclm(len),
442
20/32
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
✓ Branch 18 taken 24 times.
✓ Branch 19 taken 6 times.
✓ Branch 20 taken 55296 times.
✓ Branch 21 taken 24 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 6 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 6 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 6 times.
✗ Branch 31 not taken.
✓ Branch 32 taken 6 times.
✗ Branch 34 not taken.
✓ Branch 35 taken 6 times.
✗ Branch 37 not taken.
✓ Branch 38 taken 6 times.
✓ Branch 40 taken 24 times.
✓ Branch 41 taken 6 times.
✓ Branch 42 taken 55296 times.
✓ Branch 43 taken 24 times.
36 & smcclm(len,lsoil), stcclm(len,lsoil)
443
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 13824 times.
✓ Branch 21 taken 6 times.
36 &, sihclm(len), sicclm(len)
444
20/32
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 13824 times.
✓ Branch 21 taken 6 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 6 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 6 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 6 times.
✓ Branch 31 taken 13824 times.
✓ Branch 32 taken 6 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 6 times.
✗ Branch 36 not taken.
✓ Branch 37 taken 6 times.
✗ Branch 39 not taken.
✓ Branch 40 taken 6 times.
✓ Branch 42 taken 13824 times.
✓ Branch 43 taken 6 times.
72 &, vmnclm(len), vmxclm(len), slpclm(len), absclm(len)
445 !
446 ! analyzed surface fields (last character 'a' or 'anl' indicate analysis)
447 !
448 character*500 fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa,
449 & fnplra,fntg3a,fnscva,fnsmca,fnstca,fnacna,
450 & fnvega,fnveta,fnsota
451 &, fnvmna,fnvmxa,fnslpa,fnabsa
452 !
453
15/24
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 13824 times.
✓ Branch 21 taken 6 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 6 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 6 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 6 times.
✓ Branch 31 taken 13824 times.
✓ Branch 32 taken 6 times.
54 real (kind=kind_io8) tsfanl(len), wetanl(len), snoanl(len),
454
17/26
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 24 times.
✓ Branch 21 taken 6 times.
✓ Branch 22 taken 55296 times.
✓ Branch 23 taken 24 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 6 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 6 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 6 times.
✓ Branch 33 taken 13824 times.
✓ Branch 34 taken 6 times.
54 & zoranl(len), albanl(len,4), aisanl(len),
455
15/24
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 13824 times.
✓ Branch 21 taken 6 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 6 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 6 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 6 times.
✓ Branch 31 taken 13824 times.
✓ Branch 32 taken 6 times.
54 & tg3anl(len), acnanl(len), cnpanl(len),
456
15/24
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 13824 times.
✓ Branch 21 taken 6 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 6 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 6 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 6 times.
✓ Branch 31 taken 13824 times.
✓ Branch 32 taken 6 times.
36 & cvanl (len), cvbanl(len), cvtanl(len),
457
15/24
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 13824 times.
✓ Branch 21 taken 6 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 6 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 6 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 6 times.
✓ Branch 31 taken 13824 times.
✓ Branch 32 taken 6 times.
54 & scvanl(len), tsfan2(len), veganl(len),
458
22/34
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 13824 times.
✓ Branch 21 taken 6 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 6 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 6 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 6 times.
✓ Branch 31 taken 13824 times.
✓ Branch 32 taken 6 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 6 times.
✗ Branch 36 not taken.
✓ Branch 37 taken 6 times.
✗ Branch 39 not taken.
✓ Branch 40 taken 6 times.
✓ Branch 42 taken 12 times.
✓ Branch 43 taken 6 times.
✓ Branch 44 taken 27648 times.
✓ Branch 45 taken 12 times.
72 & vetanl(len), sotanl(len), alfanl(len,2), slianl(len),
459
20/32
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
✓ Branch 18 taken 24 times.
✓ Branch 19 taken 6 times.
✓ Branch 20 taken 55296 times.
✓ Branch 21 taken 24 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 6 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 6 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 6 times.
✗ Branch 31 not taken.
✓ Branch 32 taken 6 times.
✗ Branch 34 not taken.
✓ Branch 35 taken 6 times.
✗ Branch 37 not taken.
✓ Branch 38 taken 6 times.
✓ Branch 40 taken 24 times.
✓ Branch 41 taken 6 times.
✓ Branch 42 taken 55296 times.
✓ Branch 43 taken 24 times.
36 & smcanl(len,lsoil), stcanl(len,lsoil)
460
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 13824 times.
✓ Branch 21 taken 6 times.
36 &, sihanl(len), sicanl(len)
461
20/32
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 13824 times.
✓ Branch 21 taken 6 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 6 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 6 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 6 times.
✓ Branch 31 taken 13824 times.
✓ Branch 32 taken 6 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 6 times.
✗ Branch 36 not taken.
✓ Branch 37 taken 6 times.
✗ Branch 39 not taken.
✓ Branch 40 taken 6 times.
✓ Branch 42 taken 13824 times.
✓ Branch 43 taken 6 times.
72 &, vmnanl(len), vmxanl(len), slpanl(len), absanl(len)
462 !
463
5/8
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
18 real (kind=kind_io8) tsfan0(len) ! sea surface temperature analysis at ft=0.
464 !
465 ! predicted surface fields (last characters 'fcs' indicates forecast)
466 !
467
5/8
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
18 real (kind=kind_io8) tsffcs(len), wetfcs(len), snofcs(len),
468 & zorfcs(len), albfcs(len,4), aisfcs(len),
469 & tg3fcs(len), acnfcs(len), cnpfcs(len),
470 & cvfcs (len), cvbfcs(len), cvtfcs(len),
471 & slifcs(len), vegfcs(len),
472 & vetfcs(len), sotfcs(len), alffcs(len,2),
473 & smcfcs(len,lsoil), stcfcs(len,lsoil)
474 &, sihfcs(len), sicfcs(len), sitfcs(len)
475 &, vmnfcs(len), vmxfcs(len), slpfcs(len), absfcs(len)
476 &, swdfcs(len), slcfcs(len,lsoil)
477 &, sst_perturbation
478 ! ratio of sigma level 1 wind and 10m wind (diagnozed by model and not touched
479 ! in this program).
480 !
481 real (kind=kind_io8) f10m (len)
482 real (kind=kind_io8) fsmcl(25),fsmcs(25),fstcl(25),fstcs(25)
483 real (kind=kind_io8) fcsmcl(25),fcsmcs(25),fcstcl(25),fcstcs(25)
484
485 !clu [+1l] add swratio (soil moisture liquid-to-total ratio)
486
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
✓ Branch 18 taken 24 times.
✓ Branch 19 taken 6 times.
✓ Branch 20 taken 55296 times.
✓ Branch 21 taken 24 times.
18 real (kind=kind_io8) swratio(len,lsoil)
487 !clu [+1l] add fixratio (option to adjust slc from smc)
488
5/8
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 24 times.
✓ Branch 10 taken 6 times.
18 logical fixratio(lsoil)
489 !
490 integer icsmcl(25), icsmcs(25), icstcl(25), icstcs(25)
491 !
492 real (kind=kind_io8) csmcl(25), csmcs(25)
493 real (kind=kind_io8) cstcl(25), cstcs(25)
494 !
495 real (kind=kind_io8) slmskh(mdata)
496 character*500 fnmskh
497 6 integer kpd7, kpd9
498 !
499
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 13824 times.
✓ Branch 21 taken 6 times.
18 logical icefl1(len), icefl2(len)
500 !
501 ! input and output surface fields (bges) file names
502 !
503 !
504 ! sigma level 1 temperature for dead start
505 !
506 real (kind=kind_io8) sig1t(len)
507 !
508 character*32 label
509 !
510 ! = 1 ==> forecast is used
511 ! = 0 ==> analysis (or climatology) is used
512 !
513 ! output file ... primary surface file for radiation and forecast
514 !
515 ! rec. 1 label
516 ! rec. 2 date record
517 ! rec. 3 tsf
518 ! rec. 4 soilm(two layers) ----> 4 layers
519 ! rec. 5 snow
520 ! rec. 6 soilt(two layers) ----> 4 layers
521 ! rec. 7 tg3
522 ! rec. 8 zor
523 ! rec. 9 cv
524 ! rec. 10 cvb
525 ! rec. 11 cvt
526 ! rec. 12 albedo (four types)
527 ! rec. 13 slimsk
528 ! rec. 14 vegetation cover
529 ! rec. 14 plantr -----> skip this record
530 ! rec. 15 f10m -----> canopy
531 ! rec. 16 canopy water content (cnpanl) -----> f10m
532 ! rec. 17 vegetation type
533 ! rec. 18 soil type
534 ! rec. 19 zeneith angle dependent vegetation fraction (two types)
535 ! rec. 20 uustar
536 ! rec. 21 ffmm
537 ! rec. 22 ffhh
538 !cwu add sih & sic
539 ! rec. 23 sih(one category only)
540 ! rec. 24 sic
541 !clu [+8l] add prcp, flag, swd, slc, vmn, vmx, slp, abs
542 ! rec. 25 tprcp
543 ! rec. 26 srflag
544 ! rec. 27 swd
545 ! rec. 28 slc (4 layers)
546 ! rec. 29 vmn
547 ! rec. 30 vmx
548 ! rec. 31 slp
549 ! rec. 32 abs
550
551 !
552 ! debug only
553 ! ldebug=.true. creates bges files for climatology and analysis
554 ! lqcbgs=.true. quality controls input bges file before merging (should have been
555 ! qced in the forecast program)
556 !
557 logical ldebug,lqcbgs
558 6 logical lprnt
559 !
560 ! debug only
561 !
562 character*500 fndclm,fndanl
563 !
564 logical lanom
565
566 !
567 namelist/namsfc/fnglac,fnmxic,
568 & fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc,
569 & fnplrc,fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,
570 & fnvegc,fnvetc,fnsotc,fnalbc2,
571 & fnvmnc,fnvmxc,fnslpc,fnabsc,
572 & fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa,
573 & fnplra,fntg3a,fnscva,fnsmca,fnstca,fnacna,
574 & fnvega,fnveta,fnsota,
575 & fnvmna,fnvmxa,fnslpa,fnabsa,
576 & fnmskh,
577 & ldebug,lgchek,lqcbgs,critp1,critp2,critp3,
578 & fndclm,fndanl,
579 & lanom,
580 & ftsfl,ftsfs,falbl,falbs,faisl,faiss,fsnol,fsnos,
581 & fzorl,fzors,fplrl,fplrs,fsmcl,fsmcs,
582 & fstcl,fstcs,fvegl,fvegs,fvetl,fvets,fsotl,fsots,
583 & fctsfl,fctsfs,fcalbl,fcalbs,fcsnol,fcsnos,
584 & fczorl,fczors,fcplrl,fcplrs,fcsmcl,fcsmcs,
585 & fcstcl,fcstcs,fsalfl,fsalfs,fcalfl,flalfs,
586 & fsihl,fsicl,fsihs,fsics,aislim,sihnew,
587 & fvmnl,fvmns,fvmxl,fvmxs,fslpl,fslps,
588 & fabsl,fabss,
589 & ictsfl,ictsfs,icalbl,icalbs,icsnol,icsnos,
590 & iczorl,iczors,icplrl,icplrs,icsmcl,icsmcs,
591 & icstcl,icstcs,icalfl,icalfs,
592 & gausm, deads, qcmsk, znlst,
593 & monclm, monanl, monfcs, monmer, mondif, igrdbg,
594 & blnmsk, bltmsk, landice
595 !
596 data gausm/.true./, deads/.false./, blnmsk/0.0/, bltmsk/90.0/
597 &, qcmsk/.false./, znlst/.false./, igrdbg/-1/
598 &, monclm/.false./, monanl/.false./, monfcs/.false./
599 &, monmer/.false./, mondif/.false./, landice/.true./
600 !
601 ! defaults file names
602 !
603 data fnmskh/'global_slmask.t126.grb'/
604 data fnalbc/'global_albedo4.1x1.grb'/
605 data fnalbc2/'global_albedo4.1x1.grb'/
606 data fntsfc/'global_sstclim.2x2.grb'/
607 data fnsotc/'global_soiltype.1x1.grb'/
608 data fnvegc/'global_vegfrac.1x1.grb'/
609 data fnvetc/'global_vegtype.1x1.grb'/
610 data fnglac/'global_glacier.2x2.grb'/
611 data fnmxic/'global_maxice.2x2.grb'/
612 data fnsnoc/'global_snoclim.1.875.grb'/
613 data fnzorc/'global_zorclim.1x1.grb'/
614 data fnaisc/'global_iceclim.2x2.grb'/
615 data fntg3c/'global_tg3clim.2.6x1.5.grb'/
616 data fnsmcc/'global_soilmcpc.1x1.grb'/
617 !clu [+4l] add fn()c for vmn, vmx, abs, slp
618 data fnvmnc/'global_shdmin.0.144x0.144.grb'/
619 data fnvmxc/'global_shdmax.0.144x0.144.grb'/
620 data fnslpc/'global_slope.1x1.grb'/
621 data fnabsc/'global_snoalb.1x1.grb'/
622 !
623 data fnwetc/' '/
624 data fnplrc/' '/
625 data fnstcc/' '/
626 data fnscvc/' '/
627 data fnacnc/' '/
628 !
629 data fntsfa/' '/
630 data fnweta/' '/
631 data fnsnoa/' '/
632 data fnzora/' '/
633 data fnalba/' '/
634 data fnaisa/' '/
635 data fnplra/' '/
636 data fntg3a/' '/
637 data fnsmca/' '/
638 data fnstca/' '/
639 data fnscva/' '/
640 data fnacna/' '/
641 data fnvega/' '/
642 data fnveta/' '/
643 data fnsota/' '/
644 !clu [+4l] add fn()a for vmn, vmx, abs, slp
645 data fnvmna/' '/
646 data fnvmxa/' '/
647 data fnslpa/' '/
648 data fnabsa/' '/
649 !
650 data ldebug/.false./, lqcbgs/.true./
651 data fndclm/' '/
652 data fndanl/' '/
653 data lanom/.false./
654 !
655 ! default relaxation time in hours to analysis or climatology
656 data ftsfl/99999.0/, ftsfs/0.0/
657 data falbl/0.0/, falbs/0.0/
658 data falfl/0.0/, falfs/0.0/
659 data faisl/0.0/, faiss/0.0/
660 data fsnol/0.0/, fsnos/99999.0/
661 data fzorl/0.0/, fzors/99999.0/
662 data fplrl/0.0/, fplrs/0.0/
663 data fvetl/0.0/, fvets/99999.0/
664 data fsotl/0.0/, fsots/99999.0/
665 data fvegl/0.0/, fvegs/99999.0/
666 !cwu [+4l] add f()l and f()s for sih, sic and aislim, sihlim
667 data fsihl/99999.0/, fsihs/99999.0/
668 ! data fsicl/99999.0/, fsics/99999.0/
669 data fsicl/0.0/, fsics/0.0/
670 ! default ice concentration limit (50%), new ice thickness (20cm)
671 !cwu change ice concentration limit (15%) Jan 2015
672 ! data aislim/0.50/, sihnew/0.2/
673 data aislim/0.15/, sihnew/0.2/
674 !clu [+4l] add f()l and f()s for vmn, vmx, abs, slp
675 data fvmnl/0.0/, fvmns/99999.0/
676 data fvmxl/0.0/, fvmxs/99999.0/
677 data fslpl/0.0/, fslps/99999.0/
678 data fabsl/0.0/, fabss/99999.0/
679 ! default relaxation time in hours to climatology if analysis missing
680 data fctsfl/99999.0/, fctsfs/99999.0/
681 data fcalbl/99999.0/, fcalbs/99999.0/
682 data fcsnol/99999.0/, fcsnos/99999.0/
683 data fczorl/99999.0/, fczors/99999.0/
684 data fcplrl/99999.0/, fcplrs/99999.0/
685 ! default flag to apply climatological annual cycle
686 data ictsfl/0/, ictsfs/1/
687 data icalbl/1/, icalbs/1/
688 data icalfl/1/, icalfs/1/
689 data icsnol/0/, icsnos/0/
690 data iczorl/1/, iczors/0/
691 data icplrl/1/, icplrs/0/
692 !
693 data ccnp/1.0/
694 data ccv/1.0/, ccvb/1.0/, ccvt/1.0/
695 !
696 data ifp/0/
697 !
698 save ifp,fnglac,fnmxic,
699 & fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc,
700 & fnplrc,fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc,
701 & fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa,
702 & fnplra,fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega,
703 & fnvetc,fnveta,
704 & fnsotc,fnsota,
705 !clu [+2l] add fn()c and fn()a for vmn, vmx, slp, abs
706 & fnvmnc,fnvmxc,fnabsc,fnslpc,
707 & fnvmna,fnvmxa,fnabsa,fnslpa,
708 & ldebug,lgchek,lqcbgs,critp1,critp2,critp3,
709 & fndclm,fndanl,
710 & lanom,
711 & ftsfl,ftsfs,falbl,falbs,faisl,faiss,fsnol,fsnos,
712 & fzorl,fzors,fplrl,fplrs,fsmcl,fsmcs,falfl,falfs,
713 & fstcl,fstcs,fvegl,fvegs,fvetl,fvets,fsotl,fsots,
714 & fctsfl,fctsfs,fcalbl,fcalbs,fcsnol,fcsnos,
715 & fczorl,fczors,fcplrl,fcplrs,fcsmcl,fcsmcs,
716 & fcstcl,fcstcs,fcalfl,fcalfs,
717 !cwu [+1l] add f()l and f()s for sih, sic and aislim, sihnew
718 & fsihl,fsihs,fsicl,fsics,aislim,sihnew,
719 !clu [+2l] add f()l and f()s for vmn, vmx, slp, abs
720 & fvmnl,fvmns,fvmxl,fvmxs,fslpl,fslps,
721 & fabsl,fabss,
722 & ictsfl,ictsfs,icalbl,icalbs,icsnol,icsnos,
723 & iczorl,iczors,icplrl,icplrs,icsmcl,icsmcs,
724 & icstcl,icstcs,icalfl,icalfs,
725 & gausm, deads, qcmsk,
726 & monclm, monanl, monfcs, monmer, mondif, igrdbg,
727 & grboro, grbmsk,
728 !
729 & ctsfl, ctsfs, calbl, calfl, calbs, calfs, csmcs,
730 & csnol, csnos, czorl, czors, cplrl, cplrs, cstcl,
731 & cstcs, cvegl, cvwgs, cvetl, cvets, csotl, csots,
732 & csmcl
733 !cwu [+1l] add c()l and c()s for sih, sic
734 &, csihl, csihs, csicl, csics
735 !clu [+2l] add c()l and c()s for vmn, vmx, slp, abs
736 &, cvmnl, cvmns, cvmxl, cvmxs, cslpl, cslps,
737 & cabsl, cabss
738 &, imsk, jmsk, slmskh, blnmsk, bltmsk
739 &, glacir, amxice, tsfcl0
740 &, caisl, caiss, cvegs
741 !
742 6 lprnt = .false.
743 6 iprnt = 1
744 ! do i=1,len
745 ! if (ifp .eq. 0 .and. rla(i) .gt. 80.0) print *,' rla=',rla(i)
746 ! *,' rlo=',rlo(i)
747 ! tem1 = abs(rla(i) - 48.75)
748 ! tem2 = abs(rlo(i) - (-68.50))
749 ! if(tem1 .lt. 0.25 .and. tem2 .lt. 0.50) then
750 ! lprnt = .true.
751 ! iprnt = i
752 ! print *,' lprnt=',lprnt,' iprnt=',iprnt
753 ! print *,' rla(i)=',rla(i),' rlo(i)=',rlo(i)
754 ! endif
755 ! enddo
756
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (ialb == 1) then
757 6 kpdabs = kpdabs_1
758 6 kpdalb = kpdalb_1
759 6 alblmx = .99
760 6 albsmx = .99
761 6 alblmn = .01
762 6 albsmn = .01
763 6 abslmx = 1.0
764 6 abssmx = 1.0
765 6 abssmn = .01
766 6 abslmn = .01
767 else
768 kpdabs = kpdabs_0
769 kpdalb = kpdalb_0
770 alblmx = .80
771 albsmx = .80
772 alblmn = .06
773 albsmn = .06
774 abslmx = .80
775 abssmx = .80
776 abslmn = .01
777 abssmn = .01
778 endif
779
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(ifp.eq.0) then
780 6 ifp = 1
781
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do k=1,lsoil
782
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
24 fsmcl(k) = 99999.
783
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
24 fsmcs(k) = 0.
784
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
24 fstcl(k) = 99999.
785
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
30 fstcs(k) = 0.
786 enddo
787 #ifdef INTERNAL_FILE_NML
788
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
6 read(input_nml_file, nml=namsfc)
789 #else
790 ! print *,' in sfcsub nlunit=',nlunit,' me=',me,' ialb=',ialb
791 rewind(nlunit)
792 read (nlunit,namsfc)
793 #endif
794 ! write(6,namsfc)
795 !
796
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
797 1 print *,'ftsfl,falbl,faisl,fsnol,fzorl=',
798 2 & ftsfl,falbl,faisl,fsnol,fzorl
799
2/4
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
1 print *,'fsmcl=',fsmcl(1:lsoil)
800
2/4
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
1 print *,'fstcl=',fstcl(1:lsoil)
801 1 print *,'ftsfs,falbs,faiss,fsnos,fzors=',
802 2 & ftsfs,falbs,faiss,fsnos,fzors
803
2/4
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
1 print *,'fsmcs=',fsmcs(1:lsoil)
804
2/4
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
1 print *,'fstcs=',fstcs(1:lsoil)
805 1 print *,' aislim=',aislim,' sihnew=',sihnew
806 1 print *,' isot=', isot,' ivegsrc=',ivegsrc
807 endif
808
809
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (ivegsrc == 2) then ! sib
810 veg_type_landice=13
811 else
812 6 veg_type_landice=15
813 endif
814
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (isot == 0) then
815 soil_type_landice=9
816 else
817 6 soil_type_landice=16
818 endif
819 !
820 6 deltf = deltsfc / 24.0
821 !
822 6 ctsfl=0. !... tsfc over land
823
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(ftsfl.ge.99999.) ctsfl=1.
824
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((ftsfl.gt.0.).and.(ftsfl.lt.99999)) ctsfl=exp(-deltf/ftsfl)
825 !
826 6 ctsfs=0. !... tsfc over sea
827
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(ftsfs.ge.99999.) ctsfs=1.
828
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 6 times.
✗ Branch 3 not taken.
6 if((ftsfs.gt.0.).and.(ftsfs.lt.99999)) ctsfs=exp(-deltf/ftsfs)
829 !
830
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do k=1,lsoil
831
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
24 csmcl(k)=0. !... soilm over land
832
5/10
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✓ Branch 6 taken 24 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✓ Branch 9 taken 24 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 24 times.
24 if(fsmcl(k).ge.99999.) csmcl(k)=1.
833
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 24 times.
✓ Branch 12 taken 24 times.
✗ Branch 13 not taken.
✗ Branch 14 not taken.
✓ Branch 15 taken 24 times.
24 if((fsmcl(k).gt.0.).and.(fsmcl(k).lt.99999))
834 & csmcl(k)=exp(-deltf/fsmcl(k))
835
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
24 csmcs(k)=0. !... soilm over sea
836
3/10
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
24 if(fsmcs(k).ge.99999.) csmcs(k)=1.
837
5/12
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 24 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 24 times.
✗ Branch 14 not taken.
✗ Branch 15 not taken.
24 if((fsmcs(k).gt.0.).and.(fsmcs(k).lt.99999))
838
0/8
✗ Branch 0 not taken.
✗ Branch 1 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
6 & csmcs(k)=exp(-deltf/fsmcs(k))
839 enddo
840 !
841 6 calbl=0. !... albedo over land
842
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(falbl.ge.99999.) calbl=1.
843
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
6 if((falbl.gt.0.).and.(falbl.lt.99999)) calbl=exp(-deltf/falbl)
844 !
845 6 calfl=0. !... fraction field for albedo over land
846
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(falfl.ge.99999.) calfl=1.
847
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
6 if((falfl.gt.0.).and.(falfl.lt.99999)) calfl=exp(-deltf/falfl)
848 !
849 6 calbs=0. !... albedo over sea
850
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(falbs.ge.99999.) calbs=1.
851
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
6 if((falbs.gt.0.).and.(falbs.lt.99999)) calbs=exp(-deltf/falbs)
852 !
853 6 calfs=0. !... fraction field for albedo over sea
854
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(falfs.ge.99999.) calfs=1.
855
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
6 if((falfs.gt.0.).and.(falfs.lt.99999)) calfs=exp(-deltf/falfs)
856 !
857 6 caisl=0. !... sea ice over land
858
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(faisl.ge.99999.) caisl=1.
859
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((faisl.gt.0.).and.(faisl.lt.99999)) caisl=1.
860 !
861 6 caiss=0. !... sea ice over sea
862
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(faiss.ge.99999.) caiss=1.
863
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((faiss.gt.0.).and.(faiss.lt.99999)) caiss=1.
864 !
865 6 csnol=0. !... snow over land
866
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fsnol.ge.99999.) csnol=1.
867
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fsnol.gt.0.).and.(fsnol.lt.99999)) csnol=exp(-deltf/fsnol)
868 ! using the same way to bending snow as narr when fsnol is the negative value
869 ! the magnitude of fsnol is the thread to determine the lower and upper bound
870 ! of final swe
871
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fsnol.lt.0.)csnol=fsnol
872 !
873 6 csnos=0. !... snow over sea
874
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fsnos.ge.99999.) csnos=1.
875
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fsnos.gt.0.).and.(fsnos.lt.99999)) csnos=exp(-deltf/fsnos)
876 !
877 6 czorl=0. !... roughness length over land
878
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fzorl.ge.99999.) czorl=1.
879
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
6 if((fzorl.gt.0.).and.(fzorl.lt.99999)) czorl=exp(-deltf/fzorl)
880 !
881 6 czors=0. !... roughness length over sea
882
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fzors.ge.99999.) czors=1.
883
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fzors.gt.0.).and.(fzors.lt.99999)) czors=exp(-deltf/fzors)
884 !
885 ! cplrl=0. !... plant resistance over land
886 ! if(fplrl.ge.99999.) cplrl=1.
887 ! if((fplrl.gt.0.).and.(fplrl.lt.99999)) cplrl=exp(-deltf/fplrl)
888 !
889 ! cplrs=0. !... plant resistance over sea
890 ! if(fplrs.ge.99999.) cplrs=1.
891 ! if((fplrs.gt.0.).and.(fplrs.lt.99999)) cplrs=exp(-deltf/fplrs)
892 !
893
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do k=1,lsoil
894
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
24 cstcl(k)=0. !... soilt over land
895
5/10
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✓ Branch 6 taken 24 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✓ Branch 9 taken 24 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 24 times.
24 if(fstcl(k).ge.99999.) cstcl(k)=1.
896
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 24 times.
✓ Branch 12 taken 24 times.
✗ Branch 13 not taken.
✗ Branch 14 not taken.
✓ Branch 15 taken 24 times.
24 if((fstcl(k).gt.0.).and.(fstcl(k).lt.99999))
897 & cstcl(k)=exp(-deltf/fstcl(k))
898
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
24 cstcs(k)=0. !... soilt over sea
899
3/10
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
24 if(fstcs(k).ge.99999.) cstcs(k)=1.
900
5/12
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 24 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 24 times.
✗ Branch 14 not taken.
✗ Branch 15 not taken.
24 if((fstcs(k).gt.0.).and.(fstcs(k).lt.99999))
901
0/8
✗ Branch 0 not taken.
✗ Branch 1 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
6 & cstcs(k)=exp(-deltf/fstcs(k))
902 enddo
903 !
904 6 cvegl=0. !... vegetation fraction over land
905
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fvegl.ge.99999.) cvegl=1.
906
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
6 if((fvegl.gt.0.).and.(fvegl.lt.99999)) cvegl=exp(-deltf/fvegl)
907 !
908 6 cvegs=0. !... vegetation fraction over sea
909
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fvegs.ge.99999.) cvegs=1.
910
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fvegs.gt.0.).and.(fvegs.lt.99999)) cvegs=exp(-deltf/fvegs)
911 !
912 6 cvetl=0. !... vegetation type over land
913
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fvetl.ge.99999.) cvetl=1.
914
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fvetl.gt.0.).and.(fvetl.lt.99999)) cvetl=exp(-deltf/fvetl)
915 !
916 6 cvets=0. !... vegetation type over sea
917
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fvets.ge.99999.) cvets=1.
918
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fvets.gt.0.).and.(fvets.lt.99999)) cvets=exp(-deltf/fvets)
919 !
920 6 csotl=0. !... soil type over land
921
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fsotl.ge.99999.) csotl=1.
922
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fsotl.gt.0.).and.(fsotl.lt.99999)) csotl=exp(-deltf/fsotl)
923 !
924 6 csots=0. !... soil type over sea
925
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fsots.ge.99999.) csots=1.
926
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fsots.gt.0.).and.(fsots.lt.99999)) csots=exp(-deltf/fsots)
927
928 !cwu [+16l]---------------------------------------------------------------
929 !
930 6 csihl=0. !... sea ice thickness over land
931
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fsihl.ge.99999.) csihl=1.
932
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fsihl.gt.0.).and.(fsihl.lt.99999)) csihl=exp(-deltf/fsihl)
933 !
934 6 csihs=0. !... sea ice thickness over sea
935
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fsihs.ge.99999.) csihs=1.
936
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fsihs.gt.0.).and.(fsihs.lt.99999)) csihs=exp(-deltf/fsihs)
937 !
938 6 csicl=0. !... sea ice concentration over land
939
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fsicl.ge.99999.) csicl=1.
940
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fsicl.gt.0.).and.(fsicl.lt.99999)) csicl=exp(-deltf/fsicl)
941 !
942 6 csics=0. !... sea ice concentration over sea
943
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fsics.ge.99999.) csics=1.
944
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fsics.gt.0.).and.(fsics.lt.99999)) csics=exp(-deltf/fsics)
945
946 !clu [+32l]---------------------------------------------------------------
947 !
948 6 cvmnl=0. !... min veg cover over land
949
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fvmnl.ge.99999.) cvmnl=1.
950
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fvmnl.gt.0.).and.(fvmnl.lt.99999)) cvmnl=exp(-deltf/fvmnl)
951 !
952 6 cvmns=0. !... min veg cover over sea
953
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fvmns.ge.99999.) cvmns=1.
954
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fvmns.gt.0.).and.(fvmns.lt.99999)) cvmns=exp(-deltf/fvmns)
955 !
956 6 cvmxl=0. !... max veg cover over land
957
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fvmxl.ge.99999.) cvmxl=1.
958
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fvmxl.gt.0.).and.(fvmxl.lt.99999)) cvmxl=exp(-deltf/fvmxl)
959 !
960 6 cvmxs=0. !... max veg cover over sea
961
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fvmxs.ge.99999.) cvmxs=1.
962
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fvmxs.gt.0.).and.(fvmxs.lt.99999)) cvmxs=exp(-deltf/fvmxs)
963 !
964 6 cslpl=0. !... slope type over land
965
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fslpl.ge.99999.) cslpl=1.
966
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fslpl.gt.0.).and.(fslpl.lt.99999)) cslpl=exp(-deltf/fslpl)
967 !
968 6 cslps=0. !... slope type over sea
969
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fslps.ge.99999.) cslps=1.
970
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fslps.gt.0.).and.(fslps.lt.99999)) cslps=exp(-deltf/fslps)
971 !
972 6 cabsl=0. !... snow albedo over land
973
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fabsl.ge.99999.) cabsl=1.
974
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fabsl.gt.0.).and.(fabsl.lt.99999)) cabsl=exp(-deltf/fabsl)
975 !
976 6 cabss=0. !... snow albedo over sea
977
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fabss.ge.99999.) cabss=1.
978
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if((fabss.gt.0.).and.(fabss.lt.99999)) cabss=exp(-deltf/fabss)
979 !clu ----------------------------------------------------------------------
980 !
981 ! read a high resolution mask field for use in grib interpolation
982 !
983 call hmskrd(lugb,imsk,jmsk,fnmskh,
984 6 & kpdmsk,slmskh,gausm,blnmsk,bltmsk,me)
985 ! if (qcmsk) call qcmask(slmskh,sllnd,slsea,imsk,jmsk,rla,rlo)
986 !
987
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
988 1 write(6,*) ' '
989 1 write(6,*) ' lugb=',lugb,' len=',len, ' lsoil=',lsoil
990 1 write(6,*) 'iy=',iy,' im=',im,' id=',id,' ih=',ih,' fh=',fh
991
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
1 &, ' sig1t(1)=',sig1t(1)
992 2 &, ' gausm=',gausm,' blnmsk=',blnmsk,' bltmsk=',bltmsk
993 1 write(6,*) ' '
994 endif
995 !
996 ! reading permanent/extreme features (glacier points and maximum ice extent)
997 !
998
7/14
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
6 allocate (tsfcl0(len))
999
7/14
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
6 allocate (glacir(len))
1000
7/14
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
6 allocate (amxice(len))
1001 !
1002 ! read glacier
1003 !
1004 6 kpd9 = -1
1005 6 kpd7 = -1
1006 call fixrdc(lugb,fnglac,kpdgla,kpd7,kpd9,slmask,
1007 & glacir,len,iret
1008 &, imsk, jmsk, slmskh, gausm, blnmsk, bltmsk
1009 6 &, rla, rlo, me)
1010 ! znnt=1.
1011 ! call nntprt(glacir,len,znnt)
1012 !
1013 ! read maximum ice extent
1014 !
1015 6 kpd7 = -1
1016 call fixrdc(lugb,fnmxic,kpdmxi,kpd7,kpd9,slmask,
1017 & amxice,len,iret
1018 &, imsk, jmsk, slmskh, gausm, blnmsk, bltmsk
1019 6 &, rla, rlo, me)
1020 ! znnt=1.
1021 ! call nntprt(amxice,len,znnt)
1022 !
1023 6 crit=0.5
1024 6 call rof01(glacir,len,'ge',crit)
1025 6 call rof01(amxice,len,'ge',crit)
1026 !
1027 ! quality control max ice limit based on glacier points
1028 !
1029 6 call qcmxice(glacir,amxice,len,me)
1030 !
1031 endif ! first time loop finished
1032 !
1033
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
1034
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 sliclm(i) = 1.
1035
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 snoclm(i) = 0.
1036
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13830 icefl1(i) = .true.
1037 enddo
1038 ! if(lprnt) print *,' tsffcsin=',tsffcs(iprnt)
1039 !
1040 ! read climatology fields
1041 !
1042
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
1043 1 write(6,*) '=============='
1044 1 write(6,*) 'climatology'
1045 1 write(6,*) '=============='
1046 endif
1047 !
1048 6 percrit=critp1
1049 !
1050 call clima(lugb,iy,im,id,ih,fh,len,lsoil,slmask,
1051 & fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc,
1052 & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc,
1053 & fnvetc,fnsotc,
1054 & fnvmnc,fnvmxc,fnslpc,fnabsc,
1055 & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm,aisclm,
1056 & tg3clm,cvclm ,cvbclm,cvtclm,
1057 & cnpclm,smcclm,stcclm,sliclm,scvclm,acnclm,vegclm,
1058 & vetclm,sotclm,alfclm,
1059 & vmnclm,vmxclm,slpclm,absclm,
1060 & kpdtsf,kpdwet,kpdsno,kpdzor,kpdalb,kpdais,
1061 & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg,
1062 & kpdvet,kpdsot,kpdalf,tsfcl0,
1063 & kpdvmn,kpdvmx,kpdslp,kpdabs,
1064 & deltsfc, lanom
1065 &, imsk, jmsk, slmskh, rla, rlo, gausm, blnmsk, bltmsk,me
1066 &, lprnt,iprnt,fnalbc2,ialb,tile_num_ch,i_index,j_index
1067 6 &, sst_perturbation)
1068 ! if(lprnt) print *,'tsfclm=',tsfclm(iprnt),' tsfcl2=',tsfcl2(iprnt)
1069 !
1070 ! scale surface roughness and albedo to model required units
1071 !
1072 6 zsca=100.
1073 6 call scale(zorclm,len,zsca)
1074 6 zsca=0.01
1075 6 call scale(albclm,len,zsca)
1076
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 call scale(albclm(1,2),len,zsca)
1077
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 call scale(albclm(1,3),len,zsca)
1078
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 call scale(albclm(1,4),len,zsca)
1079 6 call scale(alfclm,len,zsca)
1080
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 call scale(alfclm(1,2),len,zsca)
1081 !clu [+4l] scale vmn, vmx, abs from percent to fraction
1082 6 zsca=0.01
1083 6 call scale(vmnclm,len,zsca)
1084 6 call scale(vmxclm,len,zsca)
1085 6 call scale(absclm,len,zsca)
1086
1087 !
1088 ! set albedo over ocean to albomx
1089 !
1090 6 call albocn(albclm,slmask,albomx,len)
1091 !
1092 ! make sure vegetation type and soil type are non zero over land
1093 !
1094 6 call landtyp(vetclm,sotclm,slpclm,slmask,len)
1095 !
1096 !cwu [-1l/+1l]
1097 !* ice concentration or ice mask (only ice mask used in the model now)
1098 ! ice concentration and ice mask (both are used in the model now)
1099 !
1100
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnaisc(1:8).ne.' ') then
1101 !cwu [+5l/-1l] update sihclm, sicclm
1102
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
1103
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 sihclm(i) = 3.0*aisclm(i)
1104
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 sicclm(i) = aisclm(i)
1105
11/18
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 13824 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 13824 times.
✓ Branch 18 taken 9809 times.
✓ Branch 19 taken 4015 times.
✓ Branch 20 taken 4 times.
✓ Branch 21 taken 9805 times.
✓ Branch 22 taken 4 times.
✗ Branch 23 not taken.
13824 if(slmask(i).eq.0..and.glacir(i).eq.1..and.
1106 6 & sicclm(i).ne.1.) then
1107
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 4 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4 times.
4 sicclm(i) = sicimx
1108
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 4 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4 times.
4 sihfcs(i) = glacir_hice
1109 endif
1110 enddo
1111 6 crit=aislim
1112 !* crit=0.5
1113 6 call rof01(aisclm,len,'ge',crit)
1114 elseif(fnacnc(1:8).ne.' ') then
1115 !cwu [+4l] update sihclm, sicclm
1116 do i=1,len
1117 sihclm(i) = 3.0*acnclm(i)
1118 sicclm(i) = acnclm(i)
1119 if(slmask(i).eq.0..and.glacir(i).eq.1..and.
1120 & sicclm(i).ne.1.) then
1121 sicclm(i) = sicimx
1122 sihfcs(i) = glacir_hice
1123 endif
1124 enddo
1125 call rof01(acnclm,len,'ge',aislim)
1126 do i=1,len
1127 aisclm(i) = acnclm(i)
1128 enddo
1129 endif
1130 !
1131 ! quality control of sea ice mask
1132 !
1133 call qcsice(aisclm,glacir,amxice,aicice,aicsea,sllnd,slmask,
1134 6 & rla,rlo,len,me)
1135 !
1136 ! set ocean/land/sea-ice mask
1137 !
1138 6 call setlsi(slmask,aisclm,len,aicice,sliclm)
1139 ! if(lprnt) print *,' aisclm=',aisclm(iprnt),' sliclm='
1140 ! *,sliclm(iprnt),' slmask=',slmask(iprnt)
1141 !
1142 ! write(6,*) 'sliclm'
1143 ! znnt=1.
1144 ! call nntprt(sliclm,len,znnt)
1145 !
1146 ! quality control of snow
1147 !
1148 6 call qcsnow(snoclm,slmask,aisclm,glacir,len,snosmx,landice,me)
1149 !
1150 6 call setzro(snoclm,epssno,len)
1151 !
1152 ! snow cover handling (we assume climatological snow depth is available)
1153 ! quality control of snow depth (note that snow should be corrected first
1154 ! because it influences tsf
1155 !
1156 6 kqcm=1
1157 call qcmxmn('snow ',snoclm,sliclm,snoclm,icefl1,
1158 & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn,
1159 & snojmx,snojmn,snosmx,snosmn,epssno,
1160 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1161 ! write(6,*) 'snoclm'
1162 ! znnt=1.
1163 ! call nntprt(snoclm,len,znnt)
1164 !
1165 ! get snow cover from snow depth array
1166 !
1167
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnscvc(1:8).eq.' ') then
1168 6 call getscv(snoclm,scvclm,len)
1169 endif
1170 !
1171 ! set tsfc over snow to tsfsmx if greater
1172 !
1173 6 call snosfc(snoclm,tsfclm,tsfsmx,len,me)
1174 ! call snosfc(snoclm,tsfcl2,tsfsmx,len)
1175
1176 !
1177 ! quality control
1178 !
1179
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
1180
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 icefl2(i) = sicclm(i) .gt. 0.99999
1181 enddo
1182 6 kqcm=1
1183 call qcmxmn('tsfc ',tsfclm,sliclm,snoclm,icefl2,
1184 & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn,
1185 & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf,
1186 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1187 call qcmxmn('tsf2 ',tsfcl2,sliclm,snoclm,icefl2,
1188 & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn,
1189 & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf,
1190 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1191
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do kk = 1, 4
1192
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
24 call qcmxmn('albc ',albclm(1,kk),sliclm,snoclm,icefl1,
1193 & alblmx,alblmn,albomx,albomn,albimx,albimn,
1194 & albjmx,albjmn,albsmx,albsmn,epsalb,
1195 30 & rla,rlo,len,kqcm,percrit,lgchek,me)
1196 enddo
1197
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnwetc(1:8).ne.' ') then
1198 call qcmxmn('wetc ',wetclm,sliclm,snoclm,icefl1,
1199 & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn,
1200 & wetjmx,wetjmn,wetsmx,wetsmn,epswet,
1201 & rla,rlo,len,kqcm,percrit,lgchek,me)
1202 endif
1203 call qcmxmn('zorc ',zorclm,sliclm,snoclm,icefl1,
1204 & zorlmx,zorlmn,zoromx,zoromn,zorimx,zorimn,
1205 & zorjmx,zorjmn,zorsmx,zorsmn,epszor,
1206 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1207 ! if(fnplrc(1:8).ne.' ') then
1208 ! call qcmxmn('plntc ',plrclm,sliclm,snoclm,icefl1,
1209 ! & plrlmx,plrlmn,plromx,plromn,plrimx,plrimn,
1210 ! & plrjmx,plrjmn,plrsmx,plrsmn,epsplr,
1211 ! & rla,rlo,len,kqcm,percrit,lgchek,me)
1212 ! endif
1213 call qcmxmn('tg3c ',tg3clm,sliclm,snoclm,icefl1,
1214 & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3imx,tg3imn,
1215 & tg3jmx,tg3jmn,tg3smx,tg3smn,epstg3,
1216 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1217 !
1218 ! get soil temp and moisture (after all the qcs are completed)
1219 !
1220
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnsmcc(1:8).eq.' ') then
1221 call getsmc(wetclm,len,lsoil,smcclm,me)
1222 endif
1223
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc1c ',smcclm(1,1),sliclm,snoclm,icefl1,
1224 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
1225 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
1226 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1227
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc2c ',smcclm(1,2),sliclm,snoclm,icefl1,
1228 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
1229 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
1230 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1231 !clu [+8l] add smcclm(3:4)
1232
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(lsoil.gt.2) then
1233
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc3c ',smcclm(1,3),sliclm,snoclm,icefl1,
1234 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
1235 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
1236 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1237
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc4c ',smcclm(1,4),sliclm,snoclm,icefl1,
1238 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
1239 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
1240 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1241 endif
1242
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnstcc(1:8).eq.' ') then
1243 6 call getstc(tsfclm,tg3clm,sliclm,len,lsoil,stcclm,tsfimx)
1244 endif
1245
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc1c ',stcclm(1,1),sliclm,snoclm,icefl1,
1246 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1247 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1248 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1249
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc2c ',stcclm(1,2),sliclm,snoclm,icefl1,
1250 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1251 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1252 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1253 !clu [+8l] add stcclm(3:4)
1254
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(lsoil.gt.2) then
1255
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc3c ',stcclm(1,3),sliclm,snoclm,icefl1,
1256 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1257 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1258 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1259
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc4c ',stcclm(1,4),sliclm,snoclm,icefl1,
1260 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1261 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1262 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1263 endif
1264 call qcmxmn('vegc ',vegclm,sliclm,snoclm,icefl1,
1265 & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn,
1266 & vegjmx,vegjmn,vegsmx,vegsmn,epsveg,
1267 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1268 call qcmxmn('vetc ',vetclm,sliclm,snoclm,icefl1,
1269 & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn,
1270 & vetjmx,vetjmn,vetsmx,vetsmn,epsvet,
1271 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1272 call qcmxmn('sotc ',sotclm,sliclm,snoclm,icefl1,
1273 & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn,
1274 & sotjmx,sotjmn,sotsmx,sotsmn,epssot,
1275 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1276 !cwu [+8l] ---------------------------------------------------------------
1277 call qcmxmn('sihc ',sihclm,sliclm,snoclm,icefl1,
1278 & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn,
1279 & sihjmx,sihjmn,sihsmx,sihsmn,epssih,
1280 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1281 call qcmxmn('sicc ',sicclm,sliclm,snoclm,icefl1,
1282 & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn,
1283 & sicjmx,sicjmn,sicsmx,sicsmn,epssic,
1284 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1285 !clu [+16l] ---------------------------------------------------------------
1286 call qcmxmn('vmnc ',vmnclm,sliclm,snoclm,icefl1,
1287 & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn,
1288 & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn,
1289 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1290 call qcmxmn('vmxc ',vmxclm,sliclm,snoclm,icefl1,
1291 & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn,
1292 & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx,
1293 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1294 call qcmxmn('slpc ',slpclm,sliclm,snoclm,icefl1,
1295 & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn,
1296 & slpjmx,slpjmn,slpsmx,slpsmn,epsslp,
1297 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1298 call qcmxmn('absc ',absclm,sliclm,snoclm,icefl1,
1299 & abslmx,abslmn,absomx,absomn,absimx,absimn,
1300 & absjmx,absjmn,abssmx,abssmn,epsabs,
1301 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1302 !clu ----------------------------------------------------------------------
1303 !
1304 ! monitoring prints
1305 !
1306
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (monclm) then
1307 if (me .eq. 0) then
1308 print *,' '
1309 print *,'monitor of time and space interpolated climatology'
1310 print *,' '
1311 ! call count(sliclm,snoclm,len)
1312 print *,' '
1313 call monitr('tsfclm',tsfclm,sliclm,snoclm,len)
1314 call monitr('albclm',albclm(1,1),sliclm,snoclm,len)
1315 call monitr('albclm',albclm(1,2),sliclm,snoclm,len)
1316 call monitr('albclm',albclm(1,3),sliclm,snoclm,len)
1317 call monitr('albclm',albclm(1,4),sliclm,snoclm,len)
1318 call monitr('aisclm',aisclm,sliclm,snoclm,len)
1319 call monitr('snoclm',snoclm,sliclm,snoclm,len)
1320 call monitr('scvclm',scvclm,sliclm,snoclm,len)
1321 call monitr('smcclm1',smcclm(1,1),sliclm,snoclm,len)
1322 call monitr('smcclm2',smcclm(1,2),sliclm,snoclm,len)
1323 call monitr('stcclm1',stcclm(1,1),sliclm,snoclm,len)
1324 call monitr('stcclm2',stcclm(1,2),sliclm,snoclm,len)
1325 !clu [+4l] add smcclm(3:4) and stcclm(3:4)
1326 if(lsoil.gt.2) then
1327 call monitr('smcclm3',smcclm(1,3),sliclm,snoclm,len)
1328 call monitr('smcclm4',smcclm(1,4),sliclm,snoclm,len)
1329 call monitr('stcclm3',stcclm(1,3),sliclm,snoclm,len)
1330 call monitr('stcclm4',stcclm(1,4),sliclm,snoclm,len)
1331 endif
1332 call monitr('tg3clm',tg3clm,sliclm,snoclm,len)
1333 call monitr('zorclm',zorclm,sliclm,snoclm,len)
1334 ! if (gaus) then
1335 call monitr('cvaclm',cvclm ,sliclm,snoclm,len)
1336 call monitr('cvbclm',cvbclm,sliclm,snoclm,len)
1337 call monitr('cvtclm',cvtclm,sliclm,snoclm,len)
1338 ! endif
1339 call monitr('sliclm',sliclm,sliclm,snoclm,len)
1340 ! call monitr('plrclm',plrclm,sliclm,snoclm,len)
1341 call monitr('orog ',orog ,sliclm,snoclm,len)
1342 call monitr('vegclm',vegclm,sliclm,snoclm,len)
1343 call monitr('vetclm',vetclm,sliclm,snoclm,len)
1344 call monitr('sotclm',sotclm,sliclm,snoclm,len)
1345 !cwu [+2l] add sih, sic
1346 call monitr('sihclm',sihclm,sliclm,snoclm,len)
1347 call monitr('sicclm',sicclm,sliclm,snoclm,len)
1348 !clu [+4l] add vmn, vmx, slp, abs
1349 call monitr('vmnclm',vmnclm,sliclm,snoclm,len)
1350 call monitr('vmxclm',vmxclm,sliclm,snoclm,len)
1351 call monitr('slpclm',slpclm,sliclm,snoclm,len)
1352 call monitr('absclm',absclm,sliclm,snoclm,len)
1353 endif
1354 endif
1355 !
1356 !
1357
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
1358 1 write(6,*) '=============='
1359 1 write(6,*) ' analysis'
1360 1 write(6,*) '=============='
1361 endif
1362 !
1363 ! fill in analysis array with climatology before reading analysis.
1364 !
1365 call filanl(tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl,aisanl,
1366 & tg3anl,cvanl ,cvbanl,cvtanl,
1367 & cnpanl,smcanl,stcanl,slianl,scvanl,veganl,
1368 & vetanl,sotanl,alfanl,
1369 & sihanl,sicanl,
1370 & vmnanl,vmxanl,slpanl,absanl,
1371 & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm,aisclm,
1372 & tg3clm,cvclm ,cvbclm,cvtclm,
1373 & cnpclm,smcclm,stcclm,sliclm,scvclm,vegclm,
1374 & vetclm,sotclm,alfclm,
1375 & sihclm,sicclm,
1376 & vmnclm,vmxclm,slpclm,absclm,
1377 6 & len,lsoil)
1378 !
1379 ! reverse scaling to match with grib analysis input
1380 !
1381 6 zsca=0.01
1382 6 call scale(zoranl,len, zsca)
1383 6 zsca=100.
1384 6 call scale(albanl,len,zsca)
1385
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 call scale(albanl(1,2),len,zsca)
1386
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 call scale(albanl(1,3),len,zsca)
1387
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 call scale(albanl(1,4),len,zsca)
1388 6 call scale(alfanl,len,zsca)
1389
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 call scale(alfanl(1,2),len,zsca)
1390 !clu [+4l] reverse scale for vmn, vmx, abs
1391 6 zsca=100.
1392 6 call scale(vmnanl,len,zsca)
1393 6 call scale(vmxanl,len,zsca)
1394 6 call scale(absanl,len,zsca)
1395 !
1396 6 percrit=critp2
1397 !
1398 ! read analysis fields
1399 !
1400 call analy(lugb,iy,im,id,ih,fh,len,lsoil,slmask,
1401 & fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa,
1402 & fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega,
1403 & fnveta,fnsota,
1404 & fnvmna,fnvmxa,fnslpa,fnabsa,
1405 & tsfanl,wetanl,snoanl,zoranl,albanl,aisanl,
1406 & tg3anl,cvanl ,cvbanl,cvtanl,
1407 & smcanl,stcanl,slianl,scvanl,acnanl,veganl,
1408 & vetanl,sotanl,alfanl,tsfan0,
1409 & vmnanl,vmxanl,slpanl,absanl,
1410 & kpdtsf,kpdwet,kpdsno,kpdsnd,kpdzor,kpdalb,kpdais,
1411 & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg,
1412 & kpdvet,kpdsot,kpdalf,
1413 & kpdvmn,kpdvmx,kpdslp,kpdabs,
1414 & irttsf,irtwet,irtsno,irtzor,irtalb,irtais,
1415 & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg,
1416 & irtvet,irtsot,irtalf
1417 &, irtvmn,irtvmx,irtslp,irtabs,
1418 & imsk, jmsk, slmskh, rla, rlo, gausm, blnmsk, bltmsk
1419 6 &, me, lanom)
1420 ! if(lprnt) print *,' tsfanl=',tsfanl(iprnt)
1421 !
1422 ! scale zor and alb to match forecast model units
1423 !
1424 6 zsca=100.
1425 6 call scale(zoranl,len, zsca)
1426 6 zsca=0.01
1427 6 call scale(albanl,len,zsca)
1428
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 call scale(albanl(1,2),len,zsca)
1429
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 call scale(albanl(1,3),len,zsca)
1430
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 call scale(albanl(1,4),len,zsca)
1431 6 call scale(alfanl,len,zsca)
1432
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 call scale(alfanl(1,2),len,zsca)
1433 !clu [+4] scale vmn, vmx, abs from percent to fraction
1434 6 zsca=0.01
1435 6 call scale(vmnanl,len,zsca)
1436 6 call scale(vmxanl,len,zsca)
1437 6 call scale(absanl,len,zsca)
1438 !
1439 ! interpolate climatology but fixing initial anomaly
1440 !
1441
1/6
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
6 if(fh > 0.0 .and. fntsfa(1:8) /= ' ' .and. lanom) then
1442 call anomint(tsfan0,tsfclm,tsfcl0,tsfanl,len)
1443 endif
1444 !
1445 ! if the tsfanl is at sea level, then bring it to the surface using
1446 ! unfiltered orography (for lakes). if the analysis is at lake surface
1447 ! as in the nst model, then this call should be removed - moorthi 09/23/2011
1448 !
1449
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if (use_ufo .and. .not. nst_anl) then
1450 ztsfc = 0.0
1451 call tsfcor(tsfanl,orog_uf,slmask,ztsfc,len,rlapse)
1452 endif
1453 !
1454 ! ice concentration or ice mask (only ice mask used in the model now)
1455 !
1456
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnaisa(1:8).ne.' ') then
1457 !cwu [+5l/-1l] update sihanl, sicanl
1458 do i=1,len
1459 sihanl(i) = 3.0*aisanl(i)
1460 sicanl(i) = aisanl(i)
1461 if(slmask(i).eq.0..and.glacir(i).eq.1..and.
1462 & sicanl(i).ne.1.) then
1463 sicanl(i) = sicimx
1464 sihfcs(i) = glacir_hice
1465 endif
1466 enddo
1467 crit=aislim
1468 !* crit=0.5
1469 call rof01(aisanl,len,'ge',crit)
1470
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 elseif(fnacna(1:8).ne.' ') then
1471 !cwu [+17l] update sihanl, sicanl
1472 do i=1,len
1473 sihanl(i) = 3.0*acnanl(i)
1474 sicanl(i) = acnanl(i)
1475 if(slmask(i).eq.0..and.glacir(i).eq.1..and.
1476 & sicanl(i).ne.1.) then
1477 sicanl(i) = sicimx
1478 sihfcs(i) = glacir_hice
1479 endif
1480 enddo
1481 crit=aislim
1482 do i=1,len
1483 if((slianl(i).eq.0.).and.(sicanl(i).ge.crit)) then
1484 slianl(i)=2.
1485 ! print *,'cycle - new ice form: fice=',sicanl(i)
1486 else if((slianl(i).ge.2.).and.(sicanl(i).lt.crit)) then
1487 slianl(i)=0.
1488 ! print *,'cycle - ice free: fice=',sicanl(i)
1489 else if((slianl(i).eq.1.).and.(sicanl(i).ge.sicimn)) then
1490 ! print *,'cycle - land covered by sea-ice: fice=',sicanl(i)
1491 sicanl(i)=0.
1492 endif
1493 enddo
1494 ! znnt=10.
1495 ! call nntprt(acnanl,len,znnt)
1496 ! if(lprnt) print *,' acnanl=',acnanl(iprnt)
1497 ! do i=1,len
1498 ! if (acnanl(i) .gt. 0.3 .and. aisclm(i) .eq. 1.0
1499 ! & .and. aisfcs(i) .ge. 0.75) acnanl(i) = aislim
1500 ! enddo
1501 ! if(lprnt) print *,' acnanl=',acnanl(iprnt)
1502 call rof01(acnanl,len,'ge',aislim)
1503 do i=1,len
1504 aisanl(i)=acnanl(i)
1505 enddo
1506 endif
1507 ! if(lprnt) print *,' aisanl1=',aisanl(iprnt),' glacir='
1508 ! &,glacir(iprnt),' slmask=',slmask(iprnt)
1509 !
1510 call qcsice(aisanl,glacir,amxice,aicice,aicsea,sllnd,slmask,
1511 6 & rla,rlo,len,me)
1512 !
1513 ! set ocean/land/sea-ice mask
1514 !
1515 6 call setlsi(slmask,aisanl,len,aicice,slianl)
1516 ! if(lprnt) print *,' aisanl=',aisanl(iprnt),' slianl='
1517 ! *,slianl(iprnt),' slmask=',slmask(iprnt)
1518 !
1519 !
1520
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do k=1,lsoil
1521
2/2
✓ Branch 0 taken 55296 times.
✓ Branch 1 taken 24 times.
55326 do i=1,len
1522
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✓ Branch 6 taken 36740 times.
✓ Branch 7 taken 18556 times.
55320 if (slianl(i) .eq. 0) then
1523
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 36740 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 36740 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 36740 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 36740 times.
36740 smcanl(i,k) = smcomx
1524
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 36740 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 36740 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 36740 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 36740 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 36740 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 36740 times.
36740 stcanl(i,k) = tsfanl(i)
1525 endif
1526 enddo
1527 enddo
1528
1529 ! write(6,*) 'slianl'
1530 ! znnt=1.
1531 ! call nntprt(slianl,len,znnt)
1532 !cwu [+8l]----------------------------------------------------------------------
1533 call qcmxmn('siha ',sihanl,slianl,snoanl,icefl1,
1534 & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn,
1535 & sihjmx,sihjmn,sihsmx,sihsmn,epssih,
1536 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1537 call qcmxmn('sica ',sicanl,slianl,snoanl,icefl1,
1538 & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn,
1539 & sicjmx,sicjmn,sicsmx,sicsmn,epssic,
1540 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1541 !
1542 ! set albedo over ocean to albomx
1543 !
1544 6 call albocn(albanl,slmask,albomx,len)
1545 !
1546 ! quality control of snow and sea-ice
1547 ! process snow depth or snow cover
1548 !
1549
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnsnoa(1:8).ne.' ') then
1550 call setzro(snoanl,epssno,len)
1551 call qcsnow(snoanl,slmask,aisanl,glacir,len,ten,landice,me)
1552 if (.not.landice) then
1553 call snodpth2(glacir,snosmx,snoanl, len, me)
1554 endif
1555 kqcm=1
1556 call snosfc(snoanl,tsfanl,tsfsmx,len,me)
1557 call qcmxmn('snoa ',snoanl,slianl,snoanl,icefl1,
1558 & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn,
1559 & snojmx,snojmn,snosmx,snosmn,epssno,
1560 & rla,rlo,len,kqcm,percrit,lgchek,me)
1561 call getscv(snoanl,scvanl,len)
1562 call qcmxmn('sncva ',scvanl,slianl,snoanl,icefl1,
1563 & scvlmx,scvlmn,scvomx,scvomn,scvimx,scvimn,
1564 & scvjmx,scvjmn,scvsmx,scvsmn,epsscv,
1565 & rla,rlo,len,kqcm,percrit,lgchek,me)
1566 else
1567 6 crit=0.5
1568 6 call rof01(scvanl,len,'ge',crit)
1569 6 call qcsnow(scvanl,slmask,aisanl,glacir,len,one,landice,me)
1570 call qcmxmn('sncva ',scvanl,slianl,scvanl,icefl1,
1571 & scvlmx,scvlmn,scvomx,scvomn,scvimx,scvimn,
1572 & scvjmx,scvjmn,scvsmx,scvsmn,epsscv,
1573 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1574 call snodpth(scvanl,slianl,tsfanl,snoclm,
1575 6 & glacir,snwmax,snwmin,landice,len,snoanl,me)
1576 6 call qcsnow(scvanl,slmask,aisanl,glacir,len,snosmx,landice,me)
1577 6 call snosfc(snoanl,tsfanl,tsfsmx,len,me)
1578 call qcmxmn('snowa ',snoanl,slianl,snoanl,icefl1,
1579 & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn,
1580 & snojmx,snojmn,snosmx,snosmn,epssno,
1581 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1582 endif
1583 !
1584
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
1585
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 icefl2(i) = sicanl(i) .gt. 0.99999
1586 enddo
1587 call qcmxmn('tsfa ',tsfanl,slianl,snoanl,icefl2,
1588 & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn,
1589 & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf,
1590 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1591
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do kk = 1, 4
1592
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
24 call qcmxmn('alba ',albanl(1,kk),slianl,snoanl,icefl1,
1593 & alblmx,alblmn,albomx,albomn,albimx,albimn,
1594 & albjmx,albjmn,albsmx,albsmn,epsalb,
1595 30 & rla,rlo,len,kqcm,percrit,lgchek,me)
1596 enddo
1597
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if(fnwetc(1:8).ne.' ' .or. fnweta(1:8).ne.' ' ) then
1598 call qcmxmn('weta ',wetanl,slianl,snoanl,icefl1,
1599 & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn,
1600 & wetjmx,wetjmn,wetsmx,wetsmn,epswet,
1601 & rla,rlo,len,kqcm,percrit,lgchek,me)
1602 endif
1603 call qcmxmn('zora ',zoranl,slianl,snoanl,icefl1,
1604 & zorlmx,zorlmn,zoromx,zoromn,zorimx,zorimn,
1605 & zorjmx,zorjmn,zorsmx,zorsmn,epszor,
1606 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1607 ! if(fnplrc(1:8).ne.' ' .or. fnplra(1:8).ne.' ' ) then
1608 ! call qcmxmn('plna ',plranl,slianl,snoanl,icefl1,
1609 ! & plrlmx,plrlmn,plromx,plromn,plrimx,plrimn,
1610 ! & plrjmx,plrjmn,plrsmx,plrsmn,epsplr,
1611 ! & rla,rlo,len,kqcm,percrit,lgchek,me)
1612 ! endif
1613 call qcmxmn('tg3a ',tg3anl,slianl,snoanl,icefl1,
1614 & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3imx,tg3imn,
1615 & tg3jmx,tg3jmn,tg3smx,tg3smn,epstg3,
1616 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1617 !
1618 ! get soil temp and moisture
1619 !
1620
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if(fnsmca(1:8).eq.' ' .and. fnsmcc(1:8).eq.' ') then
1621 call getsmc(wetanl,len,lsoil,smcanl,me)
1622 endif
1623
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc1a ',smcanl(1,1),slianl,snoanl,icefl1,
1624 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
1625 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
1626 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1627
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc2a ',smcanl(1,2),slianl,snoanl,icefl1,
1628 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
1629 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
1630 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1631 !clu [+8l] add smcanl(3:4)
1632
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(lsoil.gt.2) then
1633
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc3a ',smcanl(1,3),slianl,snoanl,icefl1,
1634 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
1635 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
1636 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1637
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc4a ',smcanl(1,4),slianl,snoanl,icefl1,
1638 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
1639 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
1640 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1641 endif
1642
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnstca(1:8).eq.' ') then
1643 6 call getstc(tsfanl,tg3anl,slianl,len,lsoil,stcanl,tsfimx)
1644 endif
1645
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc1a ',stcanl(1,1),slianl,snoanl,icefl1,
1646 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1647 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1648 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1649
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc2a ',stcanl(1,2),slianl,snoanl,icefl1,
1650 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1651 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1652 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1653 !clu [+8l] add stcanl(3:4)
1654
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(lsoil.gt.2) then
1655
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc3a ',stcanl(1,3),slianl,snoanl,icefl1,
1656 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1657 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1658 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1659
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc4a ',stcanl(1,4),slianl,snoanl,icefl1,
1660 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1661 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1662 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1663 endif
1664 call qcmxmn('vega ',veganl,slianl,snoanl,icefl1,
1665 & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn,
1666 & vegjmx,vegjmn,vegsmx,vegsmn,epsveg,
1667 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1668 call qcmxmn('veta ',vetanl,slianl,snoanl,icefl1,
1669 & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn,
1670 & vetjmx,vetjmn,vetsmx,vetsmn,epsvet,
1671 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1672 call qcmxmn('sota ',sotanl,slianl,snoanl,icefl1,
1673 & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn,
1674 & sotjmx,sotjmn,sotsmx,sotsmn,epssot,
1675 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1676 !clu [+16l]----------------------------------------------------------------------
1677 call qcmxmn('vmna ',vmnanl,slianl,snoanl,icefl1,
1678 & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn,
1679 & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn,
1680 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1681 call qcmxmn('vmxa ',vmxanl,slianl,snoanl,icefl1,
1682 & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn,
1683 & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx,
1684 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1685 call qcmxmn('slpa ',slpanl,slianl,snoanl,icefl1,
1686 & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn,
1687 & slpjmx,slpjmn,slpsmx,slpsmn,epsslp,
1688 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1689 call qcmxmn('absa ',absanl,slianl,snoanl,icefl1,
1690 & abslmx,abslmn,absomx,absomn,absimx,absimn,
1691 & absjmx,absjmn,abssmx,abssmn,epsabs,
1692 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1693 !clu ----------------------------------------------------------------------------
1694 !
1695 ! monitoring prints
1696 !
1697
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (monanl) then
1698 if (me .eq. 0) then
1699 print *,' '
1700 print *,'monitor of time and space interpolated analysis'
1701 print *,' '
1702 ! call count(slianl,snoanl,len)
1703 print *,' '
1704 call monitr('tsfanl',tsfanl,slianl,snoanl,len)
1705 call monitr('albanl',albanl,slianl,snoanl,len)
1706 call monitr('aisanl',aisanl,slianl,snoanl,len)
1707 call monitr('snoanl',snoanl,slianl,snoanl,len)
1708 call monitr('scvanl',scvanl,slianl,snoanl,len)
1709 call monitr('smcanl1',smcanl(1,1),slianl,snoanl,len)
1710 call monitr('smcanl2',smcanl(1,2),slianl,snoanl,len)
1711 call monitr('stcanl1',stcanl(1,1),slianl,snoanl,len)
1712 call monitr('stcanl2',stcanl(1,2),slianl,snoanl,len)
1713 !clu [+4l] add smcanl(3:4) and stcanl(3:4)
1714 if(lsoil.gt.2) then
1715 call monitr('smcanl3',smcanl(1,3),slianl,snoanl,len)
1716 call monitr('smcanl4',smcanl(1,4),slianl,snoanl,len)
1717 call monitr('stcanl3',stcanl(1,3),slianl,snoanl,len)
1718 call monitr('stcanl4',stcanl(1,4),slianl,snoanl,len)
1719 endif
1720 call monitr('tg3anl',tg3anl,slianl,snoanl,len)
1721 call monitr('zoranl',zoranl,slianl,snoanl,len)
1722 ! if (gaus) then
1723 call monitr('cvaanl',cvanl ,slianl,snoanl,len)
1724 call monitr('cvbanl',cvbanl,slianl,snoanl,len)
1725 call monitr('cvtanl',cvtanl,slianl,snoanl,len)
1726 ! endif
1727 call monitr('slianl',slianl,slianl,snoanl,len)
1728 ! call monitr('plranl',plranl,slianl,snoanl,len)
1729 call monitr('orog ',orog ,slianl,snoanl,len)
1730 call monitr('veganl',veganl,slianl,snoanl,len)
1731 call monitr('vetanl',vetanl,slianl,snoanl,len)
1732 call monitr('sotanl',sotanl,slianl,snoanl,len)
1733 !cwu [+2l] add sih, sic
1734 call monitr('sihanl',sihanl,slianl,snoanl,len)
1735 call monitr('sicanl',sicanl,slianl,snoanl,len)
1736 !clu [+4l] add vmn, vmx, slp, abs
1737 call monitr('vmnanl',vmnanl,slianl,snoanl,len)
1738 call monitr('vmxanl',vmxanl,slianl,snoanl,len)
1739 call monitr('slpanl',slpanl,slianl,snoanl,len)
1740 call monitr('absanl',absanl,slianl,snoanl,len)
1741 endif
1742
1743 endif
1744 !
1745 ! read in forecast fields if needed
1746 !
1747
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
1748 1 write(6,*) '=============='
1749 1 write(6,*) ' fcst guess'
1750 1 write(6,*) '=============='
1751 endif
1752 !
1753 6 percrit=critp2
1754 !
1755
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(deads) then
1756 !
1757 ! fill in guess array with analysis if dead start.
1758 !
1759 percrit=critp3
1760 if (me .eq. 0) write(6,*) 'this run is dead start run'
1761 call filfcs(tsffcs,wetfcs,snofcs,zorfcs,albfcs,
1762 & tg3fcs,cvfcs ,cvbfcs,cvtfcs,
1763 & cnpfcs,smcfcs,stcfcs,slifcs,aisfcs,
1764 & vegfcs,vetfcs,sotfcs,alffcs,
1765 !cwu [+1l] add ()fcs for sih, sic
1766 & sihfcs,sicfcs,
1767 !clu [+1l] add ()fcs for vmn, vmx, slp, abs
1768 & vmnfcs,vmxfcs,slpfcs,absfcs,
1769 & tsfanl,wetanl,snoanl,zoranl,albanl,
1770 & tg3anl,cvanl ,cvbanl,cvtanl,
1771 & cnpanl,smcanl,stcanl,slianl,aisanl,
1772 & veganl,vetanl,sotanl,alfanl,
1773 !cwu [+1l] add ()anl for sih, sic
1774 & sihanl,sicanl,
1775 !clu [+1l] add ()anl for vmn, vmx, slp, abs
1776 & vmnanl,vmxanl,slpanl,absanl,
1777 & len,lsoil)
1778 if(sig1t(1).ne.0.) then
1779 call usesgt(sig1t,slianl,tg3anl,len,lsoil,tsffcs,stcfcs,
1780 & tsfimx)
1781 do i=1,len
1782 icefl2(i) = sicfcs(i) .gt. 0.99999
1783 enddo
1784 kqcm=1
1785 call qcmxmn('tsff ',tsffcs,slifcs,snofcs,icefl2,
1786 & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn,
1787 & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf,
1788 & rla,rlo,len,kqcm,percrit,lgchek,me)
1789 call qcmxmn('stc1f ',stcfcs(1,1),slifcs,snofcs,icefl1,
1790 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1791 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1792 & rla,rlo,len,kqcm,percrit,lgchek,me)
1793 call qcmxmn('stc2f ',stcfcs(1,2),slifcs,snofcs,icefl1,
1794 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1795 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1796 & rla,rlo,len,kqcm,percrit,lgchek,me)
1797 endif
1798 else
1799 6 percrit=critp2
1800 !
1801 ! make reverse angulation correction to tsf
1802 ! make reverse orography correction to tg3
1803 !
1804
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (use_ufo) then
1805
13/24
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 6 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 6 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 6 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 6 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 6 times.
✓ Branch 33 taken 13824 times.
✓ Branch 34 taken 6 times.
6 orogd = orog - orog_uf
1806 !
1807 ! The tiled version of the substrate temperature is properly
1808 ! adjusted to the terrain. Only invoke when using the old
1809 ! global tg3 grib file.
1810 !
1811
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if ( index(fntg3c, "tileX.nc") == 0) then ! global file
1812 6 ztsfc = 1.0
1813 6 call tsfcor(tg3fcs,orogd,slmask,ztsfc,len,-rlapse)
1814 endif
1815 6 ztsfc = 0.
1816 6 call tsfcor(tsffcs,orogd,slmask,ztsfc,len,-rlapse)
1817 else
1818 ztsfc = 0.
1819 call tsfcor(tsffcs,orog,slmask,ztsfc,len,-rlapse)
1820 endif
1821
1822 !clu [+12l] --------------------------------------------------------------
1823 !
1824 ! compute soil moisture liquid-to-total ratio over land
1825 !
1826
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do j=1, lsoil
1827
2/2
✓ Branch 0 taken 55296 times.
✓ Branch 1 taken 24 times.
55326 do i=1, len
1828
5/10
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 55296 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 55296 times.
✓ Branch 12 taken 55296 times.
✗ Branch 13 not taken.
55320 if(smcfcs(i,j) .ne. 0.) then
1829
12/24
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 55296 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 55296 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 55296 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 55296 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 55296 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 55296 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 55296 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 55296 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 55296 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 55296 times.
55296 swratio(i,j) = slcfcs(i,j)/smcfcs(i,j)
1830 else
1831 swratio(i,j) = -999.
1832 endif
1833 enddo
1834 enddo
1835 !clu -----------------------------------------------------------------------
1836 !
1837
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 6 times.
✗ Branch 3 not taken.
6 if(lqcbgs .and. irtacn .eq. 0) then
1838 6 call qcsli(slianl,slifcs,len,me)
1839 6 call albocn(albfcs,slmask,albomx,len)
1840
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
1841
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 icefl2(i) = sicfcs(i) .gt. 0.99999
1842 enddo
1843 6 kqcm=1
1844 call qcmxmn('snof ',snofcs,slifcs,snofcs,icefl1,
1845 & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn,
1846 & snojmx,snojmn,snosmx,snosmn,epssno,
1847 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1848 call qcmxmn('tsff ',tsffcs,slifcs,snofcs,icefl2,
1849 & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn,
1850 & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf,
1851 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1852
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do kk = 1, 4
1853
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
24 call qcmxmn('albf ',albfcs(1,kk),slifcs,snofcs,icefl1,
1854 & alblmx,alblmn,albomx,albomn,albimx,albimn,
1855 & albjmx,albjmn,albsmx,albsmn,epsalb,
1856 30 & rla,rlo,len,kqcm,percrit,lgchek,me)
1857 enddo
1858
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if(fnwetc(1:8).ne.' ' .or. fnweta(1:8).ne.' ' )
1859 & then
1860 call qcmxmn('wetf ',wetfcs,slifcs,snofcs,icefl1,
1861 & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn,
1862 & wetjmx,wetjmn,wetsmx,wetsmn,epswet,
1863 & rla,rlo,len,kqcm,percrit,lgchek,me)
1864 endif
1865 call qcmxmn('zorf ',zorfcs,slifcs,snofcs,icefl1,
1866 & zorlmx,zorlmn,zoromx,zoromn,zorimx,zorimn,
1867 & zorjmx,zorjmn,zorsmx,zorsmn,epszor,
1868 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1869 ! if(fnplrc(1:8).ne.' ' .or. fnplra(1:8).ne.' ' )
1870 ! call qcmxmn('plnf ',plrfcs,slifcs,snofcs,icefl1,
1871 ! & plrlmx,plrlmn,plromx,plromn,plrimx,plrimn,
1872 ! & plrjmx,plrjmn,plrsmx,plrsmn,epsplr,
1873 ! & rla,rlo,len,kqcm,percrit,lgchek,me)
1874 ! endif
1875 call qcmxmn('tg3f ',tg3fcs,slifcs,snofcs,icefl1,
1876 & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3imx,tg3imn,
1877 & tg3jmx,tg3jmn,tg3smx,tg3smn,epstg3,
1878 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1879 !cwu [+8l] ---------------------------------------------------------------
1880 call qcmxmn('sihf ',sihfcs,slifcs,snofcs,icefl1,
1881 & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn,
1882 & sihjmx,sihjmn,sihsmx,sihsmn,epssih,
1883 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1884 call qcmxmn('sicf ',sicfcs,slifcs,snofcs,icefl1,
1885 & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn,
1886 & sicjmx,sicjmn,sicsmx,sicsmn,epssic,
1887 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1888
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc1f ',smcfcs(1,1),slifcs,snofcs,icefl1,
1889 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
1890 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
1891 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1892
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc2f ',smcfcs(1,2),slifcs,snofcs,icefl1,
1893 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
1894 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
1895 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1896 !clu [+8l] add smcfcs(3:4)
1897
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(lsoil.gt.2) then
1898
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc3f ',smcfcs(1,3),slifcs,snofcs,icefl1,
1899 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
1900 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
1901 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1902
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc4f ',smcfcs(1,4),slifcs,snofcs,icefl1,
1903 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
1904 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
1905 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1906 endif
1907
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc1f ',stcfcs(1,1),slifcs,snofcs,icefl1,
1908 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1909 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1910 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1911
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc2f ',stcfcs(1,2),slifcs,snofcs,icefl1,
1912 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1913 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1914 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1915 !clu [+8l] add stcfcs(3:4)
1916
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(lsoil.gt.2) then
1917
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc3f ',stcfcs(1,3),slifcs,snofcs,icefl1,
1918 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1919 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1920 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1921
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc4f ',stcfcs(1,4),slifcs,snofcs,icefl1,
1922 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
1923 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
1924 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1925 endif
1926 call qcmxmn('vegf ',vegfcs,slifcs,snofcs,icefl1,
1927 & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn,
1928 & vegjmx,vegjmn,vegsmx,vegsmn,epsveg,
1929 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1930 call qcmxmn('vetf ',vetfcs,slifcs,snofcs,icefl1,
1931 & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn,
1932 & vetjmx,vetjmn,vetsmx,vetsmn,epsvet,
1933 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1934 call qcmxmn('sotf ',sotfcs,slifcs,snofcs,icefl1,
1935 & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn,
1936 & sotjmx,sotjmn,sotsmx,sotsmn,epssot,
1937 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1938
1939 !clu [+16l] ---------------------------------------------------------------
1940 call qcmxmn('vmnf ',vmnfcs,slifcs,snofcs,icefl1,
1941 & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn,
1942 & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn,
1943 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1944 call qcmxmn('vmxf ',vmxfcs,slifcs,snofcs,icefl1,
1945 & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn,
1946 & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx,
1947 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1948 call qcmxmn('slpf ',slpfcs,slifcs,snofcs,icefl1,
1949 & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn,
1950 & slpjmx,slpjmn,slpsmx,slpsmn,epsslp,
1951 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1952 call qcmxmn('absf ',absfcs,slifcs,snofcs,icefl1,
1953 & abslmx,abslmn,absomx,absomn,absimx,absimn,
1954 & absjmx,absjmn,abssmx,abssmn,epsabs,
1955 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
1956 !clu -----------------------------------------------------------------------
1957 endif
1958 endif
1959 !
1960
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (monfcs) then
1961 if (me .eq. 0) then
1962 print *,' '
1963 print *,'monitor of guess'
1964 print *,' '
1965 ! call count(slifcs,snofcs,len)
1966 print *,' '
1967 call monitr('tsffcs',tsffcs,slifcs,snofcs,len)
1968 call monitr('albfcs',albfcs,slifcs,snofcs,len)
1969 call monitr('aisfcs',aisfcs,slifcs,snofcs,len)
1970 call monitr('snofcs',snofcs,slifcs,snofcs,len)
1971 call monitr('smcfcs1',smcfcs(1,1),slifcs,snofcs,len)
1972 call monitr('smcfcs2',smcfcs(1,2),slifcs,snofcs,len)
1973 call monitr('stcfcs1',stcfcs(1,1),slifcs,snofcs,len)
1974 call monitr('stcfcs2',stcfcs(1,2),slifcs,snofcs,len)
1975 !clu [+4l] add smcfcs(3:4) and stcfcs(3:4)
1976 if(lsoil.gt.2) then
1977 call monitr('smcfcs3',smcfcs(1,3),slifcs,snofcs,len)
1978 call monitr('smcfcs4',smcfcs(1,4),slifcs,snofcs,len)
1979 call monitr('stcfcs3',stcfcs(1,3),slifcs,snofcs,len)
1980 call monitr('stcfcs4',stcfcs(1,4),slifcs,snofcs,len)
1981 endif
1982 call monitr('tg3fcs',tg3fcs,slifcs,snofcs,len)
1983 call monitr('zorfcs',zorfcs,slifcs,snofcs,len)
1984 ! if (gaus) then
1985 call monitr('cvafcs',cvfcs ,slifcs,snofcs,len)
1986 call monitr('cvbfcs',cvbfcs,slifcs,snofcs,len)
1987 call monitr('cvtfcs',cvtfcs,slifcs,snofcs,len)
1988 ! endif
1989 call monitr('slifcs',slifcs,slifcs,snofcs,len)
1990 ! call monitr('plrfcs',plrfcs,slifcs,snofcs,len)
1991 call monitr('orog ',orog ,slifcs,snofcs,len)
1992 call monitr('vegfcs',vegfcs,slifcs,snofcs,len)
1993 call monitr('vetfcs',vetfcs,slifcs,snofcs,len)
1994 call monitr('sotfcs',sotfcs,slifcs,snofcs,len)
1995 !cwu [+2l] add sih, sic
1996 call monitr('sihfcs',sihfcs,slifcs,snofcs,len)
1997 call monitr('sicfcs',sicfcs,slifcs,snofcs,len)
1998 !clu [+4l] add vmn, vmx, slp, abs
1999 call monitr('vmnfcs',vmnfcs,slifcs,snofcs,len)
2000 call monitr('vmxfcs',vmxfcs,slifcs,snofcs,len)
2001 call monitr('slpfcs',slpfcs,slifcs,snofcs,len)
2002 call monitr('absfcs',absfcs,slifcs,snofcs,len)
2003 endif
2004 endif
2005 !
2006 !... update annual cycle in the sst guess..
2007 !
2008 ! if(lprnt) print *,'tsfclm=',tsfclm(iprnt),' tsfcl2=',tsfcl2(iprnt)
2009 ! *,' tsffcs=',tsffcs(iprnt),' slianl=',slianl(iprnt)
2010
2011
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (fh-deltsfc > -0.001 ) then
2012 do i=1,len
2013 if(slianl(i) == 0.0) then
2014 tsffcs(i) = tsffcs(i) + (tsfclm(i) - tsfcl2(i))
2015 endif
2016 enddo
2017 endif
2018 !
2019 ! quality control analysis using forecast guess
2020 !
2021 call qcbyfc(tsffcs,snofcs,qctsfs,qcsnos,qctsfi,len,lsoil,
2022 & snoanl,aisanl,slianl,tsfanl,albanl,
2023 & zoranl,smcanl,
2024 6 & smcclm,tsfsmx,albomx,zoromx,me)
2025 !
2026 ! blend climatology and predicted fields
2027 !
2028
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if(me .eq. 0) then
2029 1 write(6,*) '=============='
2030 1 write(6,*) ' merging'
2031 1 write(6,*) '=============='
2032 endif
2033 ! if(lprnt) print *,' tsffcs=',tsffcs(iprnt)
2034 !
2035 6 percrit=critp3
2036 !
2037 ! merge analysis and forecast. note tg3, ais are not merged
2038 !
2039 call merge(len,lsoil,iy,im,id,ih,fh,deltsfc,
2040 & sihfcs,sicfcs,
2041 & vmnfcs,vmxfcs,slpfcs,absfcs,
2042 & tsffcs,wetfcs,snofcs,zorfcs,albfcs,aisfcs,
2043 & cvfcs ,cvbfcs,cvtfcs,
2044 & cnpfcs,smcfcs,stcfcs,slifcs,vegfcs,
2045 & vetfcs,sotfcs,alffcs,
2046 & sihanl,sicanl,
2047 & vmnanl,vmxanl,slpanl,absanl,
2048 & tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl,aisanl,
2049 & cvanl ,cvbanl,cvtanl,
2050 & cnpanl,smcanl,stcanl,slianl,veganl,
2051 & vetanl,sotanl,alfanl,
2052 & ctsfl,calbl,caisl,csnol,csmcl,czorl,cstcl,cvegl,
2053 & ctsfs,calbs,caiss,csnos,csmcs,czors,cstcs,cvegs,
2054 & ccv,ccvb,ccvt,ccnp,cvetl,cvets,csotl,csots,
2055 & calfl,calfs,
2056 & csihl,csihs,csicl,csics,
2057 & cvmnl,cvmns,cvmxl,cvmxs,cslpl,cslps,cabsl,cabss,
2058 & irttsf,irtwet,irtsno,irtzor,irtalb,irtais,
2059 & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg,
2060 & irtvmn,irtvmx,irtslp,irtabs,
2061 6 & irtvet,irtsot,irtalf,landice,me)
2062
2063 6 call setzro(snoanl,epssno,len)
2064
2065 ! if(lprnt) print *,' tanlm=',tsfanl(iprnt),' tfcsm=',tsffcs(iprnt)
2066 ! if(lprnt) print *,' sliam=',slianl(iprnt),' slifm=',slifcs(iprnt)
2067
2068 !
2069 ! new ice/melted ice
2070 !
2071 call newice(slianl,slifcs,tsfanl,tsffcs,len,lsoil,
2072 !cwu [+1l] add sihnew, aislim, sihanl & sicanl
2073 & sihnew,aislim,sihanl,sicanl,
2074 & albanl,snoanl,zoranl,smcanl,stcanl,
2075 & albomx,snoomx,zoromx,smcomx,smcimx,
2076 !cwu [-1l/+1l] change albimx to albimn - note albimx & albimn have been modified
2077 ! & tsfomn,tsfimx,albimx,zorimx,tgice,
2078 & tsfomn,tsfimx,albimn,zorimx,tgice,
2079 6 & rla,rlo,me)
2080
2081 ! if(lprnt) print *,'tsfanl=',tsfanl(iprnt),' tsffcs=',tsffcs(iprnt)
2082 ! if(lprnt) print *,' slian=',slianl(iprnt),' slifn=',slifcs(iprnt)
2083 !
2084 ! set tsfc to tsnow over snow
2085 !
2086 6 call snosfc(snoanl,tsfanl,tsfsmx,len,me)
2087 !
2088
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
2089
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 icefl2(i) = sicanl(i) .gt. 0.99999
2090 enddo
2091 6 kqcm=0
2092 call qcmxmn('snowm ',snoanl,slianl,snoanl,icefl1,
2093 & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn,
2094 & snojmx,snojmn,snosmx,snosmn,epssno,
2095 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2096 call qcmxmn('tsfm ',tsfanl,slianl,snoanl,icefl2,
2097 & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn,
2098 & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf,
2099 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2100
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do kk = 1, 4
2101
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
24 call qcmxmn('albm ',albanl(1,kk),slianl,snoanl,icefl1,
2102 & alblmx,alblmn,albomx,albomn,albimx,albimn,
2103 & albjmx,albjmn,albsmx,albsmn,epsalb,
2104 30 & rla,rlo,len,kqcm,percrit,lgchek,me)
2105 enddo
2106
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if(fnwetc(1:8).ne.' ' .or. fnweta(1:8).ne.' ' )
2107 & then
2108 call qcmxmn('wetm ',wetanl,slianl,snoanl,icefl1,
2109 & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn,
2110 & wetjmx,wetjmn,wetsmx,wetsmn,epswet,
2111 & rla,rlo,len,kqcm,percrit,lgchek,me)
2112 endif
2113 call qcmxmn('zorm ',zoranl,slianl,snoanl,icefl1,
2114 & zorlmx,zorlmn,zoromx,zoromn,zorimx,zorimn,
2115 & zorjmx,zorjmn,zorsmx,zorsmn,epszor,
2116 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2117 ! if(fnplrc(1:8).ne.' ' .or. fnplra(1:8).ne.' ' )
2118 ! & then
2119 ! call qcmxmn('plntm ',plranl,slianl,snoanl,icefl1,
2120 ! & plrlmx,plrlmn,plromx,plromn,plrimx,plrimn,
2121 ! & plrjmx,plrjmn,plrsmx,plrsmn,epsplr,
2122 ! & rla,rlo,len,kqcm,percrit,lgchek,me)
2123 ! endif
2124
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc1m ',stcanl(1,1),slianl,snoanl,icefl1,
2125 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
2126 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
2127 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2128
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc2m ',stcanl(1,2),slianl,snoanl,icefl1,
2129 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
2130 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
2131 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2132 !clu [+8l] add stcanl(3:4)
2133
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(lsoil.gt.2) then
2134
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc3m ',stcanl(1,3),slianl,snoanl,icefl1,
2135 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
2136 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
2137 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2138
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('stc4m ',stcanl(1,4),slianl,snoanl,icefl1,
2139 & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn,
2140 & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc,
2141 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2142 endif
2143
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc1m ',smcanl(1,1),slianl,snoanl,icefl1,
2144 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
2145 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
2146 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2147
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc2m ',smcanl(1,2),slianl,snoanl,icefl1,
2148 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
2149 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
2150 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2151 !clu [+8l] add smcanl(3:4)
2152
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(lsoil.gt.2) then
2153
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc3m ',smcanl(1,3),slianl,snoanl,icefl1,
2154 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
2155 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
2156 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2157
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 call qcmxmn('smc4m ',smcanl(1,4),slianl,snoanl,icefl1,
2158 & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn,
2159 & smcjmx,smcjmn,smcsmx,smcsmn,epssmc,
2160 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2161 endif
2162 6 kqcm=1
2163 call qcmxmn('vegm ',veganl,slianl,snoanl,icefl1,
2164 & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn,
2165 & vegjmx,vegjmn,vegsmx,vegsmn,epsveg,
2166 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2167 call qcmxmn('vetm ',vetanl,slianl,snoanl,icefl1,
2168 & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn,
2169 & vetjmx,vetjmn,vetsmx,vetsmn,epsvet,
2170 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2171 call qcmxmn('sotm ',sotanl,slianl,snoanl,icefl1,
2172 & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn,
2173 & sotjmx,sotjmn,sotsmx,sotsmn,epssot,
2174 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2175 !cwu [+8l] add sih, sic,
2176 call qcmxmn('sihm ',sihanl,slianl,snoanl,icefl1,
2177 & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn,
2178 & sihjmx,sihjmn,sihsmx,sihsmn,epssih,
2179 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2180 call qcmxmn('sicm ',sicanl,slianl,snoanl,icefl1,
2181 & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn,
2182 & sicjmx,sicjmn,sicsmx,sicsmn,epssic,
2183 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2184 !clu [+16l] add vmn, vmx, slp, abs
2185 call qcmxmn('vmnm ',vmnanl,slianl,snoanl,icefl1,
2186 & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn,
2187 & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn,
2188 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2189 call qcmxmn('vmxm ',vmxanl,slianl,snoanl,icefl1,
2190 & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn,
2191 & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx,
2192 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2193 call qcmxmn('slpm ',slpanl,slianl,snoanl,icefl1,
2194 & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn,
2195 & slpjmx,slpjmn,slpsmx,slpsmn,epsslp,
2196 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2197 call qcmxmn('absm ',absanl,slianl,snoanl,icefl1,
2198 & abslmx,abslmn,absomx,absomn,absimx,absimn,
2199 & absjmx,absjmn,abssmx,abssmn,epsabs,
2200 6 & rla,rlo,len,kqcm,percrit,lgchek,me)
2201
2202 !
2203
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if(me .eq. 0) then
2204 1 write(6,*) '=============='
2205 1 write(6,*) 'final results'
2206 1 write(6,*) '=============='
2207 endif
2208 !
2209 ! foreward correction to tg3 and tsf at the last stage
2210 !
2211 ! if(lprnt) print *,' tsfbc=',tsfanl(iprnt)
2212
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (use_ufo) then
2213 !
2214 ! The tiled version of the substrate temperature is properly
2215 ! adjusted to the terrain. Only invoke when using the old
2216 ! global tg3 grib file.
2217 !
2218
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if ( index(fntg3c, "tileX.nc") == 0) then ! global file
2219 6 ztsfc = 1.
2220 6 call tsfcor(tg3anl,orogd,slmask,ztsfc,len,rlapse)
2221 endif
2222 6 ztsfc = 0.
2223 6 call tsfcor(tsfanl,orogd,slmask,ztsfc,len,rlapse)
2224 else
2225 ztsfc = 0.
2226 call tsfcor(tsfanl,orog,slmask,ztsfc,len,rlapse)
2227 endif
2228 ! if(lprnt) print *,' tsfaf=',tsfanl(iprnt)
2229 !
2230 ! check the final merged product
2231 !
2232
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (monmer) then
2233 if(me .eq. 0) then
2234 print *,' '
2235 print *,'monitor of updated surface fields'
2236 print *,' (includes angulation correction)'
2237 print *,' '
2238 ! call count(slianl,snoanl,len)
2239 print *,' '
2240 call monitr('tsfanl',tsfanl,slianl,snoanl,len)
2241 call monitr('albanl',albanl,slianl,snoanl,len)
2242 call monitr('aisanl',aisanl,slianl,snoanl,len)
2243 call monitr('snoanl',snoanl,slianl,snoanl,len)
2244 call monitr('smcanl1',smcanl(1,1),slianl,snoanl,len)
2245 call monitr('smcanl2',smcanl(1,2),slianl,snoanl,len)
2246 call monitr('stcanl1',stcanl(1,1),slianl,snoanl,len)
2247 call monitr('stcanl2',stcanl(1,2),slianl,snoanl,len)
2248 !clu [+4l] add smcanl(3:4) and stcanl(3:4)
2249 if(lsoil.gt.2) then
2250 call monitr('smcanl3',smcanl(1,3),slianl,snoanl,len)
2251 call monitr('smcanl4',smcanl(1,4),slianl,snoanl,len)
2252 call monitr('stcanl3',stcanl(1,3),slianl,snoanl,len)
2253 call monitr('stcanl4',stcanl(1,4),slianl,snoanl,len)
2254 call monitr('tg3anl',tg3anl,slianl,snoanl,len)
2255 call monitr('zoranl',zoranl,slianl,snoanl,len)
2256 endif
2257 ! if (gaus) then
2258 call monitr('cvaanl',cvanl ,slianl,snoanl,len)
2259 call monitr('cvbanl',cvbanl,slianl,snoanl,len)
2260 call monitr('cvtanl',cvtanl,slianl,snoanl,len)
2261 ! endif
2262 call monitr('slianl',slianl,slianl,snoanl,len)
2263 ! call monitr('plranl',plranl,slianl,snoanl,len)
2264 call monitr('orog ',orog ,slianl,snoanl,len)
2265 call monitr('cnpanl',cnpanl,slianl,snoanl,len)
2266 call monitr('veganl',veganl,slianl,snoanl,len)
2267 call monitr('vetanl',vetanl,slianl,snoanl,len)
2268 call monitr('sotanl',sotanl,slianl,snoanl,len)
2269 !cwu [+2l] add sih, sic,
2270 call monitr('sihanl',sihanl,slianl,snoanl,len)
2271 call monitr('sicanl',sicanl,slianl,snoanl,len)
2272 !clu [+4l] add vmn, vmx, slp, abs
2273 call monitr('vmnanl',vmnanl,slianl,snoanl,len)
2274 call monitr('vmxanl',vmxanl,slianl,snoanl,len)
2275 call monitr('slpanl',slpanl,slianl,snoanl,len)
2276 call monitr('absanl',absanl,slianl,snoanl,len)
2277 endif
2278 endif
2279 !
2280
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (mondif) then
2281 do i=1,len
2282 tsffcs(i) = tsfanl(i) - tsffcs(i)
2283 snofcs(i) = snoanl(i) - snofcs(i)
2284 tg3fcs(i) = tg3anl(i) - tg3fcs(i)
2285 zorfcs(i) = zoranl(i) - zorfcs(i)
2286 ! plrfcs(i) = plranl(i) - plrfcs(i)
2287 ! albfcs(i) = albanl(i) - albfcs(i)
2288 slifcs(i) = slianl(i) - slifcs(i)
2289 aisfcs(i) = aisanl(i) - aisfcs(i)
2290 cnpfcs(i) = cnpanl(i) - cnpfcs(i)
2291 vegfcs(i) = veganl(i) - vegfcs(i)
2292 vetfcs(i) = vetanl(i) - vetfcs(i)
2293 sotfcs(i) = sotanl(i) - sotfcs(i)
2294 !clu [+2l] add sih, sic
2295 sihfcs(i) = sihanl(i) - sihfcs(i)
2296 sicfcs(i) = sicanl(i) - sicfcs(i)
2297 !clu [+4l] add vmn, vmx, slp, abs
2298 vmnfcs(i) = vmnanl(i) - vmnfcs(i)
2299 vmxfcs(i) = vmxanl(i) - vmxfcs(i)
2300 slpfcs(i) = slpanl(i) - slpfcs(i)
2301 absfcs(i) = absanl(i) - absfcs(i)
2302 enddo
2303 do j = 1,lsoil
2304 do i = 1,len
2305 smcfcs(i,j) = smcanl(i,j) - smcfcs(i,j)
2306 stcfcs(i,j) = stcanl(i,j) - stcfcs(i,j)
2307 enddo
2308 enddo
2309 do j = 1,4
2310 do i = 1,len
2311 albfcs(i,j) = albanl(i,j) - albfcs(i,j)
2312 enddo
2313 enddo
2314 !
2315 ! monitoring prints
2316 !
2317 if(me .eq. 0) then
2318 print *,' '
2319 print *,'monitor of difference'
2320 print *,' (includes angulation correction)'
2321 print *,' '
2322 call monitr('tsfdif',tsffcs,slianl,snoanl,len)
2323 call monitr('albdif',albfcs,slianl,snoanl,len)
2324 call monitr('albdif1',albfcs,slianl,snoanl,len)
2325 call monitr('albdif2',albfcs(1,2),slianl,snoanl,len)
2326 call monitr('albdif3',albfcs(1,3),slianl,snoanl,len)
2327 call monitr('albdif4',albfcs(1,4),slianl,snoanl,len)
2328 call monitr('aisdif',aisfcs,slianl,snoanl,len)
2329 call monitr('snodif',snofcs,slianl,snoanl,len)
2330 call monitr('smcanl1',smcfcs(1,1),slianl,snoanl,len)
2331 call monitr('smcanl2',smcfcs(1,2),slianl,snoanl,len)
2332 call monitr('stcanl1',stcfcs(1,1),slianl,snoanl,len)
2333 call monitr('stcanl2',stcfcs(1,2),slianl,snoanl,len)
2334 !clu [+4l] add smcfcs(3:4) and stc(3:4)
2335 if(lsoil.gt.2) then
2336 call monitr('smcanl3',smcfcs(1,3),slianl,snoanl,len)
2337 call monitr('smcanl4',smcfcs(1,4),slianl,snoanl,len)
2338 call monitr('stcanl3',stcfcs(1,3),slianl,snoanl,len)
2339 call monitr('stcanl4',stcfcs(1,4),slianl,snoanl,len)
2340 endif
2341 call monitr('tg3dif',tg3fcs,slianl,snoanl,len)
2342 call monitr('zordif',zorfcs,slianl,snoanl,len)
2343 ! if (gaus) then
2344 call monitr('cvadif',cvfcs ,slianl,snoanl,len)
2345 call monitr('cvbdif',cvbfcs,slianl,snoanl,len)
2346 call monitr('cvtdif',cvtfcs,slianl,snoanl,len)
2347 ! endif
2348 call monitr('slidif',slifcs,slianl,snoanl,len)
2349 ! call monitr('plrdif',plrfcs,slianl,snoanl,len)
2350 call monitr('cnpdif',cnpfcs,slianl,snoanl,len)
2351 call monitr('vegdif',vegfcs,slianl,snoanl,len)
2352 call monitr('vetdif',vetfcs,slianl,snoanl,len)
2353 call monitr('sotdif',sotfcs,slianl,snoanl,len)
2354 !cwu [+2l] add sih, sic
2355 call monitr('sihdif',sihfcs,slianl,snoanl,len)
2356 call monitr('sicdif',sicfcs,slianl,snoanl,len)
2357 !clu [+4l] add vmn, vmx, slp, abs
2358 call monitr('vmndif',vmnfcs,slianl,snoanl,len)
2359 call monitr('vmxdif',vmxfcs,slianl,snoanl,len)
2360 call monitr('slpdif',slpfcs,slianl,snoanl,len)
2361 call monitr('absdif',absfcs,slianl,snoanl,len)
2362 endif
2363 endif
2364 !
2365 !
2366
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
2367
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 tsffcs(i) = tsfanl(i)
2368
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 snofcs(i) = snoanl(i)
2369
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 tg3fcs(i) = tg3anl(i)
2370
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 zorfcs(i) = zoranl(i)
2371 ! plrfcs(i) = plranl(i)
2372 ! albfcs(i) = albanl(i)
2373
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 slifcs(i) = slianl(i)
2374
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 aisfcs(i) = aisanl(i)
2375
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 cvfcs(i) = cvanl(i)
2376
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 cvbfcs(i) = cvbanl(i)
2377
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 cvtfcs(i) = cvtanl(i)
2378
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 cnpfcs(i) = cnpanl(i)
2379
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 vegfcs(i) = veganl(i)
2380
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 vetfcs(i) = vetanl(i)
2381
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 sotfcs(i) = sotanl(i)
2382 !clu [+4l] add vmn, vmx, slp, abs
2383
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 vmnfcs(i) = vmnanl(i)
2384
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 vmxfcs(i) = vmxanl(i)
2385
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 slpfcs(i) = slpanl(i)
2386
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 absfcs(i) = absanl(i)
2387 enddo
2388
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do j = 1,lsoil
2389
2/2
✓ Branch 0 taken 55296 times.
✓ Branch 1 taken 24 times.
55326 do i = 1,len
2390
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 55296 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 55296 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 55296 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 55296 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 55296 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 55296 times.
55296 smcfcs(i,j) = smcanl(i,j)
2391
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✓ Branch 6 taken 18060 times.
✓ Branch 7 taken 37236 times.
55320 if (slifcs(i) .gt. 0.0) then
2392
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 18060 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 18060 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 18060 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 18060 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 18060 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 18060 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 18060 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 18060 times.
18060 stcfcs(i,j) = stcanl(i,j)
2393 else
2394
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 37236 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 37236 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 37236 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 37236 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 37236 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 37236 times.
37236 stcfcs(i,j) = tsffcs(i)
2395 endif
2396 enddo
2397 enddo
2398
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do j = 1,4
2399
2/2
✓ Branch 0 taken 55296 times.
✓ Branch 1 taken 24 times.
55326 do i = 1,len
2400
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 55296 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 55296 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 55296 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 55296 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 55296 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 55296 times.
55320 albfcs(i,j) = albanl(i,j)
2401 enddo
2402 enddo
2403
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 6 times.
18 do j = 1,2
2404
2/2
✓ Branch 0 taken 27648 times.
✓ Branch 1 taken 12 times.
27666 do i = 1,len
2405
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 27648 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 27648 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 27648 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 27648 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 27648 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 27648 times.
27660 alffcs(i,j) = alfanl(i,j)
2406 enddo
2407 enddo
2408
2409 !cwu [+20l] update sihfcs, sicfcs. remove sea ice over non-ice points
2410 6 crit=aislim
2411
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
2412
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 sihfcs(i) = sihanl(i)
2413
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 sitfcs(i) = tsffcs(i)
2414
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 500 times.
✓ Branch 7 taken 13324 times.
13824 if (slifcs(i).ge.2.) then
2415
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 500 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 500 times.
✓ Branch 6 taken 500 times.
✗ Branch 7 not taken.
500 if (sicfcs(i).gt.crit) then
2416
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 500 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 500 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 500 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 500 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 500 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 500 times.
500 tsffcs(i) = (sicanl(i)*tsffcs(i)
2417
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 500 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 500 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 500 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 500 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 500 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 500 times.
500 & + (sicfcs(i)-sicanl(i))*tgice)/sicfcs(i)
2418
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 500 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 500 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 500 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 500 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 500 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 500 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 500 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 500 times.
500 sitfcs(i) = (tsffcs(i)-tgice*(1.0-sicfcs(i))) / sicfcs(i)
2419 else
2420 tsffcs(i) = tsfanl(i)
2421 ! tsffcs(i) = tgice
2422 sihfcs(i) = sihnew
2423 endif
2424 endif
2425
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 sicfcs(i) = sicanl(i)
2426 enddo
2427
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
2428
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 13324 times.
✓ Branch 7 taken 500 times.
13830 if (slifcs(i).lt.1.5) then
2429
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13324 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13324 times.
13324 sihfcs(i) = 0.
2430
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13324 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13324 times.
13324 sicfcs(i) = 0.
2431
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13324 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13324 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13324 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13324 times.
13324 sitfcs(i) = tsffcs(i)
2432
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 500 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 500 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 500 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 500 times.
✓ Branch 12 taken 500 times.
✗ Branch 13 not taken.
✗ Branch 14 not taken.
✓ Branch 15 taken 500 times.
500 else if ((slifcs(i).ge.1.5).and.(sicfcs(i).lt.crit)) then
2433 print *,'warning: check, slifcs and sicfcs',
2434 & slifcs(i),sicfcs(i)
2435 endif
2436 enddo
2437
2438 !
2439 ! ensure the consistency between slc and smc
2440 !
2441
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do k=1, lsoil
2442
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
24 fixratio(k) = .false.
2443
3/10
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
30 if (fsmcl(k).lt.99999.) fixratio(k) = .true.
2444 enddo
2445
2446
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if(me .eq. 0) then
2447
5/8
✓ Branch 2 taken 5 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4 times.
✓ Branch 5 taken 1 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4 times.
1 print *,'dbgx --fixratio:',(fixratio(k),k=1,lsoil)
2448 endif
2449
2450
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do k=1, lsoil
2451
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
30 if(fixratio(k)) then
2452 do i = 1, len
2453 if(swratio(i,k) .eq. -999.) then
2454 slcfcs(i,k) = smcfcs(i,k)
2455 else
2456 slcfcs(i,k) = swratio(i,k) * smcfcs(i,k)
2457 endif
2458 if (slifcs(i) .ne. 1.0) slcfcs(i,k) = 1.0 ! flag value for non-land points.
2459 enddo
2460 endif
2461 enddo
2462 ! set liquid soil moisture to a flag value of 1.0
2463
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (landice) then
2464
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i = 1, len
2465
6/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 4015 times.
✓ Branch 7 taken 9809 times.
✓ Branch 8 taken 319 times.
✓ Branch 9 taken 3696 times.
27648 if (slifcs(i) .eq. 1.0 .and.
2466
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13830 & nint(vetfcs(i)) == veg_type_landice) then
2467
2/2
✓ Branch 0 taken 1276 times.
✓ Branch 1 taken 319 times.
1595 do k=1, lsoil
2468
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 1276 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1276 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1276 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1276 times.
1595 slcfcs(i,k) = 1.0
2469 enddo
2470 endif
2471 enddo
2472 end if
2473 !
2474 ! ensure the consistency between snwdph and sheleg
2475 !
2476
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fsnol .lt. 99999.) then
2477 if(me .eq. 0) then
2478 print *,'dbgx -- scale snwdph from sheleg'
2479 endif
2480 do i = 1, len
2481 if(slifcs(i).eq.1.) swdfcs(i) = 10.* snofcs(i)
2482 enddo
2483 endif
2484
2485 ! sea ice model only uses the liquid equivalent depth.
2486 ! so update the physical depth only for display purposes.
2487 ! use the same 3:1 ratio used by ice model.
2488
2489
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i = 1, len
2490
8/14
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 9809 times.
✓ Branch 7 taken 4015 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 9809 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 9809 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 9809 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 9809 times.
13830 if (slifcs(i).ne.1) swdfcs(i) = 3.*snofcs(i)
2491 enddo
2492
2493
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i = 1, len
2494
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 4015 times.
✓ Branch 7 taken 9809 times.
13830 if(slifcs(i).eq.1.) then
2495
7/12
✗ Branch 0 not taken.
✓ Branch 1 taken 4015 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4015 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4015 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4015 times.
✓ Branch 12 taken 362 times.
✓ Branch 13 taken 3653 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 362 times.
4015 if(snofcs(i).ne.0. .and. swdfcs(i).eq.0.) then
2496 print *,'dbgx --scale snwdph from sheleg',
2497 + i, swdfcs(i), snofcs(i)
2498 swdfcs(i) = 10.* snofcs(i)
2499 endif
2500 endif
2501 enddo
2502 ! landice mods - impose same minimum snow depth at
2503 ! landice as noah lsm. also ensure
2504 ! lower thermal boundary condition
2505 ! and skin t is no warmer than freezing
2506 ! after adjustment to terrain.
2507
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (landice) then
2508
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i = 1, len
2509
6/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 4015 times.
✓ Branch 7 taken 9809 times.
✓ Branch 8 taken 319 times.
✓ Branch 9 taken 3696 times.
27648 if (slifcs(i) .eq. 1.0 .and.
2510
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13830 & nint(vetfcs(i)) == veg_type_landice) then
2511
5/10
✗ Branch 0 not taken.
✓ Branch 1 taken 319 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 319 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 319 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 319 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 319 times.
319 snofcs(i) = max(snofcs(i),100.0) ! in mm
2512
5/10
✗ Branch 0 not taken.
✓ Branch 1 taken 319 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 319 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 319 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 319 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 319 times.
319 swdfcs(i) = max(swdfcs(i),1000.0) ! in mm
2513
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 319 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 319 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 319 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 319 times.
✓ Branch 12 taken 2 times.
✓ Branch 13 taken 317 times.
319 tg3fcs(i) = min(tg3fcs(i),273.15)
2514
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 319 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 319 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 319 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 319 times.
✓ Branch 12 taken 2 times.
✓ Branch 13 taken 317 times.
319 tsffcs(i) = min(tsffcs(i),273.15)
2515 endif
2516 enddo
2517 end if
2518 !
2519 ! if(lprnt) print *,' tsffcsf=',tsffcs(iprnt)
2520 12 return
2521 6 end subroutine sfccycle
2522 subroutine count(slimsk,sno,ijmax)
2523 use machine , only : kind_io8,kind_io4
2524 implicit none
2525 real (kind=kind_io8) rl3,rl1,rl0,rl2,rl6,rl7,rl4,rl5
2526 integer l8,l7,l1,l2,ijmax,l0,l3,l5,l6,l4,ij
2527 !
2528 real (kind=kind_io8) slimsk(1),sno(1)
2529 !
2530 ! count number of points for the four surface conditions
2531 !
2532 l0 = 0
2533 l1 = 0
2534 l2 = 0
2535 l3 = 0
2536 l4 = 0
2537 do ij=1,ijmax
2538 if(slimsk(ij).eq.0.) l1 = l1 + 1
2539 if(slimsk(ij).eq.1. .and. sno(ij).le.0.) l0 = l0 + 1
2540 if(slimsk(ij).eq.2. .and. sno(ij).le.0.) l2 = l2 + 1
2541 if(slimsk(ij).eq.1. .and. sno(ij).gt.0.) l3 = l3 + 1
2542 if(slimsk(ij).eq.2. .and. sno(ij).gt.0.) l4 = l4 + 1
2543 enddo
2544 l5 = l0 + l3
2545 l6 = l2 + l4
2546 l7 = l1 + l6
2547 l8 = l1 + l5 + l6
2548 rl0 = float(l0) / float(l8)*100.
2549 rl3 = float(l3) / float(l8)*100.
2550 rl1 = float(l1) / float(l8)*100.
2551 rl2 = float(l2) / float(l8)*100.
2552 rl4 = float(l4) / float(l8)*100.
2553 rl5 = float(l5) / float(l8)*100.
2554 rl6 = float(l6) / float(l8)*100.
2555 rl7 = float(l7) / float(l8)*100.
2556 print *,'1) no. of not snow-covered land points ',l0,' ',rl0,' '
2557 print *,'2) no. of snow covered land points ',l3,' ',rl3,' '
2558 print *,'3) no. of open sea points ',l1,' ',rl1,' '
2559 print *,'4) no. of not snow-covered seaice points ',l2,' ',rl2,' '
2560 print *,'5) no. of snow covered sea ice points ',l4,' ',rl4,' '
2561 print *,' '
2562 print *,'6) no. of land points ',l5,' ',rl5,' '
2563 print *,'7) no. sea points (including sea ice) ',l7,' ',rl7,' '
2564 print *,' (no. of sea ice points) (',l6,')',' ',rl6,' '
2565 print *,' '
2566 print *,'9) no. of total grid points ',l8
2567 ! print *,' '
2568 ! print *,' '
2569
2570 !
2571 ! if(lprnt) print *,' tsffcsf=',tsffcs(iprnt)
2572 return
2573 end
2574 subroutine monitr(lfld,fld,slimsk,sno,ijmax)
2575 use machine , only : kind_io8,kind_io4
2576 implicit none
2577 integer ij,n,ijmax
2578 !
2579 real (kind=kind_io8) fld(ijmax), slimsk(ijmax),sno(ijmax)
2580 !
2581 real (kind=kind_io8) rmax(5),rmin(5)
2582 character(len=*) lfld
2583 !
2584 ! find max/min
2585 !
2586 do n=1,5
2587 rmax(n) = -9.e20
2588 rmin(n) = 9.e20
2589 enddo
2590 !
2591 do ij=1,ijmax
2592 if(slimsk(ij).eq.0.) then
2593 rmax(1) = max(rmax(1), fld(ij))
2594 rmin(1) = min(rmin(1), fld(ij))
2595 elseif(slimsk(ij).eq.1.) then
2596 if(sno(ij).le.0.) then
2597 rmax(2) = max(rmax(2), fld(ij))
2598 rmin(2) = min(rmin(2), fld(ij))
2599 else
2600 rmax(4) = max(rmax(4), fld(ij))
2601 rmin(4) = min(rmin(4), fld(ij))
2602 endif
2603 else
2604 if(sno(ij).le.0.) then
2605 rmax(3) = max(rmax(3), fld(ij))
2606 rmin(3) = min(rmin(3), fld(ij))
2607 else
2608 rmax(5) = max(rmax(5), fld(ij))
2609 rmin(5) = min(rmin(5), fld(ij))
2610 endif
2611 endif
2612 enddo
2613 !
2614 print 100,lfld
2615 print 101,rmax(1),rmin(1)
2616 print 102,rmax(2),rmin(2), rmax(4), rmin(4)
2617 print 103,rmax(3),rmin(3), rmax(5), rmin(5)
2618 !
2619 ! print 102,rmax(2),rmin(2)
2620 ! print 103,rmax(3),rmin(3)
2621 ! print 104,rmax(4),rmin(4)
2622 ! print 105,rmax(5),rmin(5)
2623 100 format('0 *** ',a8,' ***')
2624 101 format(' open sea ......... max=',e12.4,' min=',e12.4)
2625 102 format(' land nosnow/snow .. max=',e12.4,' min=',e12.4
2626 &, ' max=',e12.4,' min=',e12.4)
2627 103 format(' seaice nosnow/snow max=',e12.4,' min=',e12.4
2628 &, ' max=',e12.4,' min=',e12.4)
2629 !
2630 ! 100 format('0',2x,'*** ',a8,' ***')
2631 ! 102 format(2x,' land without snow ..... max=',e12.4,' min=',e12.4)
2632 ! 103 format(2x,' seaice without snow ... max=',e12.4,' min=',e12.4)
2633 ! 104 format(2x,' land with snow ........ max=',e12.4,' min=',e12.4)
2634 ! 105 format(2x,' sea ice with snow ..... max=',e12.4,' min=',e12.4)
2635 !
2636 return
2637 end
2638 subroutine dayoyr(iyr,imo,idy,ldy)
2639 implicit none
2640 integer ldy,i,idy,iyr,imo
2641 !
2642 ! this routine figures out the day of the year given imo and idy
2643 !
2644 integer month(13)
2645 data month/0,31,28,31,30,31,30,31,31,30,31,30,31/
2646 if(mod(iyr,4).eq.0) month(3) = 29
2647 ldy = idy
2648 do i = 1, imo
2649 ldy = ldy + month(i)
2650 enddo
2651 return
2652 end
2653
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 subroutine hmskrd(lugb,imsk,jmsk,fnmskh,
2654 & kpds5,slmskh,gausm,blnmsk,bltmsk,me)
2655 use machine , only : kind_io8,kind_io4
2656 use sfccyc_module, only : mdata, xdata, ydata
2657 implicit none
2658 6 integer kpds5,me,i,imsk,jmsk,lugb
2659 !
2660 character*500 fnmskh
2661 !
2662 real (kind=kind_io8) slmskh(mdata)
2663 logical gausm
2664 real (kind=kind_io8) blnmsk,bltmsk
2665 !
2666 6 imsk = xdata
2667 6 jmsk = ydata
2668
2669
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
2670 1 write(6,*)' imsk=',imsk,' jmsk=',jmsk,' xdata=',xdata,' ydata='
2671 2 &, ydata
2672 endif
2673
2674 call fixrdg(lugb,imsk,jmsk,fnmskh,
2675 6 & kpds5,slmskh,gausm,blnmsk,bltmsk,me)
2676
2677 ! print *,'in sfc_sub, aft fixrdg,slmskh=',maxval(slmskh),
2678 ! & minval(slmskh),'mdata=',mdata,'imsk*jmsk=',imsk*jmsk
2679
2680
2/2
✓ Branch 0 taken 1555200 times.
✓ Branch 1 taken 6 times.
1555206 do i=1,imsk*jmsk
2681
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 1555200 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1555200 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1555200 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1555200 times.
1555206 slmskh(i) = nint(slmskh(i))
2682 enddo
2683 !
2684 6 return
2685 end
2686 6 subroutine fixrdg(lugb,idim,jdim,fngrib,
2687 6 & kpds5,gdata,gaus,blno,blto,me)
2688 use machine , only : kind_io8,kind_io4
2689 use sfccyc_module, only : mdata
2690 implicit none
2691 18 integer lgrib,n,lskip,jret,j,ndata,lugi,jdim,idim,lugb,
2692 18 & iret, me,kpds5,kdata,i,w3kindreal,w3kindint
2693 !
2694 character*(*) fngrib
2695 !
2696 real (kind=kind_io8) gdata(idim*jdim)
2697 logical gaus
2698 real (kind=kind_io8) blno,blto
2699 6 real (kind=kind_io8), allocatable :: data8(:)
2700 6 real (kind=kind_io4), allocatable :: data4(:)
2701 !
2702 6 logical*1, allocatable :: lbms(:)
2703 !
2704
4/4
✓ Branch 0 taken 1200 times.
✓ Branch 1 taken 6 times.
✓ Branch 2 taken 1200 times.
✓ Branch 3 taken 6 times.
6 integer kpds(200),kgds(200)
2705
6/6
✓ Branch 0 taken 1200 times.
✓ Branch 1 taken 6 times.
✓ Branch 2 taken 1200 times.
✓ Branch 3 taken 6 times.
✓ Branch 4 taken 1200 times.
✓ Branch 5 taken 6 times.
12 integer jpds(200),jgds(200), kpds0(200)
2706 !
2707
7/14
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
6 allocate(data8(1:idim*jdim))
2708
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
6 allocate(lbms(1:mdata))
2709 6 kpds = 0
2710 6 kgds = 0
2711 6 jpds = 0
2712 6 jgds = 0
2713 6 kpds0 = 0
2714 !
2715 ! if(me .eq. 0) then
2716 ! write(6,*) ' '
2717 ! write(6,*) '************************************************'
2718 ! endif
2719 !
2720 6 close(lugb)
2721 6 call baopenr(lugb,fngrib,iret)
2722
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (iret .ne. 0) then
2723 write(6,*) ' error in opening file ',trim(fngrib)
2724 print *,'error in opening file ',trim(fngrib)
2725 call abort
2726 endif
2727
3/4
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
✓ Branch 5 taken 1 times.
✗ Branch 6 not taken.
7 if (me .eq. 0) write(6,*) ' file ',trim(fngrib),
2728 2 & ' opened. unit=',lugb
2729 6 lugi = 0
2730 6 lskip = -1
2731 6 n = 0
2732
2/2
✓ Branch 0 taken 1200 times.
✓ Branch 1 taken 6 times.
6 jpds = -1
2733
2/2
✓ Branch 0 taken 1200 times.
✓ Branch 1 taken 6 times.
6 jgds = -1
2734 6 jpds(5) = kpds5
2735 6 kpds = jpds
2736 !
2737 call getgbh(lugb,lugi,lskip,jpds,jgds,lgrib,ndata,
2738 6 & lskip,kpds,kgds,iret)
2739 !
2740
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if(me .eq. 0) then
2741 1 write(6,*) ' first grib record.'
2742
5/8
✓ Branch 2 taken 11 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 10 times.
✓ Branch 5 taken 1 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 10 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 10 times.
1 write(6,*) ' kpds( 1-10)=',(kpds(j),j= 1,10)
2743
5/8
✓ Branch 2 taken 11 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 10 times.
✓ Branch 5 taken 1 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 10 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 10 times.
1 write(6,*) ' kpds(11-20)=',(kpds(j),j=11,20)
2744
5/8
✓ Branch 2 taken 3 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 2 times.
✓ Branch 5 taken 1 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 2 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 2 times.
1 write(6,*) ' kpds(21- )=',(kpds(j),j=21,22)
2745 endif
2746 !
2747 6 kpds0=jpds
2748 6 kpds0(4)=-1
2749 6 kpds0(18)=-1
2750
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(iret.ne.0) then
2751 write(6,*) ' error in getgbh. iret: ', iret
2752 if (iret == 99) write(6,*) ' field not found.'
2753 call abort
2754 endif
2755 !
2756 6 jpds = kpds0
2757 6 lskip = -1
2758 6 kdata=idim*jdim
2759 6 call w3kind(w3kindreal,w3kindint)
2760
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (w3kindreal == 8) then
2761 call getgb(lugb,lugi,kdata,lskip,jpds,jgds,ndata,lskip,
2762 6 & kpds,kgds,lbms,data8,jret)
2763 else if (w3kindreal == 4) then
2764 allocate(data4(1:idim*jdim))
2765 call getgb(lugb,lugi,kdata,lskip,jpds,jgds,ndata,lskip,
2766 & kpds,kgds,lbms,data4,jret)
2767 data8 = real(data4, kind=kind_io8)
2768 deallocate(data4)
2769 else
2770 write(0,*)' Invalid w3kindreal --- aborting'
2771 call abort
2772 endif
2773 !
2774
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(jret == 0) then
2775
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(ndata.eq.0) then
2776 write(6,*) ' error in getgb'
2777 write(6,*) ' kpds=',kpds
2778 write(6,*) ' kgds=',kgds
2779 call abort
2780 endif
2781 6 idim = kgds(2)
2782 6 jdim = kgds(3)
2783 6 gaus = kgds(1).eq.4
2784 6 blno = kgds(5)*1.d-3
2785 6 blto = kgds(4)*1.d-3
2786
10/18
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 6 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 6 times.
✓ Branch 24 taken 1555200 times.
✓ Branch 25 taken 6 times.
6 gdata(1:idim*jdim) = data8(1:idim*jdim)
2787
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
7 if (me == 0) write(6,*) 'idim,jdim=',idim,jdim
2788 2 &, ' gaus=',gaus,' blno=',blno,' blto=',blto
2789 else
2790 if (me ==. 0) write(6,*) 'idim,jdim=',idim,jdim
2791 &, ' gaus=',gaus,' blno=',blno,' blto=',blto
2792 write(6,*) ' error in getgb : jret=',jret
2793 write(6,*) ' kpds(13)=',kpds(13),' kpds(15)=',kpds(15)
2794 call abort
2795 endif
2796 !
2797
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 deallocate(data8)
2798
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 deallocate(lbms)
2799 12 return
2800
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 6 times.
12 end
2801 204 subroutine getarea(kgds,dlat,dlon,rslat,rnlat,wlon,elon,ijordr
2802 &, me)
2803 use machine , only : kind_io8,kind_io4
2804 implicit none
2805 204 integer j,me,kgds11
2806 204 real (kind=kind_io8) f0lon,f0lat,elon,dlon,dlat,rslat,wlon,rnlat
2807 !
2808 ! get area of the grib record
2809 !
2810 integer kgds(22)
2811 logical ijordr
2812 !
2813
2/2
✓ Branch 0 taken 34 times.
✓ Branch 1 taken 170 times.
204 if (me .eq. 0) then
2814
5/8
✓ Branch 2 taken 442 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 408 times.
✓ Branch 5 taken 34 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 408 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 408 times.
34 write(6,*) ' kgds( 1-12)=',(kgds(j),j= 1,12)
2815
5/8
✓ Branch 2 taken 374 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 340 times.
✓ Branch 5 taken 34 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 340 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 340 times.
34 write(6,*) ' kgds(13-22)=',(kgds(j),j=13,22)
2816 endif
2817 !
2818
2/2
✓ Branch 0 taken 90 times.
✓ Branch 1 taken 114 times.
204 if(kgds(1).eq.0) then ! lat/lon grid
2819 !
2820
2/2
✓ Branch 0 taken 15 times.
✓ Branch 1 taken 75 times.
90 if (me .eq. 0) write(6,*) 'lat/lon grid'
2821 90 dlat = float(kgds(10)) * 0.001
2822 90 dlon = float(kgds( 9)) * 0.001
2823 90 f0lon = float(kgds(5)) * 0.001
2824 90 f0lat = float(kgds(4)) * 0.001
2825 90 kgds11 = kgds(11)
2826
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 90 times.
90 if(kgds11.ge.128) then
2827 wlon = f0lon - dlon*(kgds(2)-1)
2828 elon = f0lon
2829 if(dlon*kgds(2).gt.359.99) then
2830 wlon =f0lon - dlon*kgds(2)
2831 endif
2832 dlon = -dlon
2833 kgds11 = kgds11 - 128
2834 else
2835 90 wlon = f0lon
2836 90 elon = f0lon + dlon*(kgds(2)-1)
2837
2/2
✓ Branch 0 taken 78 times.
✓ Branch 1 taken 12 times.
90 if(dlon*kgds(2).gt.359.99) then
2838 78 elon = f0lon + dlon*kgds(2)
2839 endif
2840 endif
2841
2/2
✓ Branch 0 taken 30 times.
✓ Branch 1 taken 60 times.
90 if(kgds11.ge.64) then
2842 30 rnlat = f0lat + dlat*(kgds(3)-1)
2843 30 rslat = f0lat
2844 30 kgds11 = kgds11 - 64
2845 else
2846 60 rnlat = f0lat
2847 60 rslat = f0lat - dlat*(kgds(3)-1)
2848 60 dlat = -dlat
2849 endif
2850
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 90 times.
90 if(kgds11.ge.32) then
2851 ijordr = .false.
2852 else
2853 90 ijordr = .true.
2854 endif
2855
2856
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 90 times.
90 if(wlon.gt.180.) wlon = wlon - 360.
2857
1/2
✓ Branch 0 taken 90 times.
✗ Branch 1 not taken.
90 if(elon.gt.180.) elon = elon - 360.
2858 90 wlon = nint(wlon*1000.) * 0.001
2859 90 elon = nint(elon*1000.) * 0.001
2860 90 rslat = nint(rslat*1000.) * 0.001
2861 90 rnlat = nint(rnlat*1000.) * 0.001
2862 90 return
2863 !
2864
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 114 times.
114 elseif(kgds(1).eq.1) then ! mercator projection
2865 write(6,*) 'mercator grid'
2866 write(6,*) 'cannot process'
2867 call abort
2868 !
2869
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 114 times.
114 elseif(kgds(1).eq.2) then ! gnomonic projection
2870 write(6,*) 'gnomonic grid'
2871 write(6,*) 'error!! gnomonic projection not coded'
2872 call abort
2873 !
2874
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 114 times.
114 elseif(kgds(1).eq.3) then ! lambert conformal
2875 write(6,*) 'lambert conformal'
2876 write(6,*) 'cannot process'
2877 call abort
2878
1/2
✓ Branch 0 taken 114 times.
✗ Branch 1 not taken.
114 elseif(kgds(1).eq.4) then ! gaussian grid
2879 !
2880
2/2
✓ Branch 0 taken 19 times.
✓ Branch 1 taken 95 times.
114 if (me .eq. 0) write(6,*) 'gaussian grid'
2881 114 dlat = 99.
2882 114 dlon = float(kgds( 9)) / 1000.0
2883 114 f0lon = float(kgds(5)) / 1000.0
2884 114 f0lat = 99.
2885 114 kgds11 = kgds(11)
2886
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 114 times.
114 if(kgds11.ge.128) then
2887 wlon = f0lon
2888 elon = f0lon
2889 if(dlon*kgds(2).gt.359.99) then
2890 wlon = f0lon - dlon*kgds(2)
2891 endif
2892 dlon = -dlon
2893 kgds11 = kgds11-128
2894 else
2895 114 wlon = f0lon
2896 114 elon = f0lon + dlon*(kgds(2)-1)
2897
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 114 times.
114 if(dlon*kgds(2).gt.359.99) then
2898 elon = f0lon + dlon*kgds(2)
2899 endif
2900 endif
2901
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 114 times.
114 if(kgds11.ge.64) then
2902 rnlat = 99.
2903 rslat = 99.
2904 kgds11 = kgds11 - 64
2905 else
2906 114 rnlat = 99.
2907 114 rslat = 99.
2908 114 dlat = -99.
2909 endif
2910
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 114 times.
114 if(kgds11.ge.32) then
2911 ijordr = .false.
2912 else
2913 114 ijordr = .true.
2914 endif
2915 114 return
2916 !
2917 elseif(kgds(1).eq.5) then ! polar strereographic
2918 write(6,*) 'polar stereographic grid'
2919 write(6,*) 'cannot process'
2920 call abort
2921 return
2922 !
2923 elseif(kgds(1).eq.13) then ! oblique lambert conformal
2924 write(6,*) 'oblique lambert conformal grid'
2925 write(6,*) 'cannot process'
2926 call abort
2927 !
2928 elseif(kgds(1).eq.50) then ! spherical coefficient
2929 write(6,*) 'spherical coefficient'
2930 write(6,*) 'cannot process'
2931 call abort
2932 return
2933 !
2934 elseif(kgds(1).eq.90) then ! space view perspective
2935 ! (orthographic grid)
2936 write(6,*) 'space view perspective grid'
2937 write(6,*) 'cannot process'
2938 call abort
2939 return
2940 !
2941 else ! unknown projection. abort.
2942 write(6,*) 'error!! unknown map projection'
2943 write(6,*) 'kgds(1)=',kgds(1)
2944 print *,'error!! unknown map projection'
2945 print *,'kgds(1)=',kgds(1)
2946 call abort
2947 endif
2948 !
2949 return
2950 end
2951 204 subroutine subst(data,imax,jmax,dlon,dlat,ijordr)
2952 use machine , only : kind_io8,kind_io4
2953 implicit none
2954 204 integer i,j,ii,jj,jmax,imax,iret
2955 real (kind=kind_io8) dlat,dlon
2956 !
2957 logical ijordr
2958 !
2959 real (kind=kind_io8) data(imax,jmax)
2960 204 real (kind=kind_io8), allocatable :: work(:,:)
2961 !
2962
5/8
✓ Branch 0 taken 204 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 204 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 174 times.
✓ Branch 5 taken 30 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 174 times.
204 if(.not.ijordr.or.
2963 & (ijordr.and.(dlat.gt.0..or.dlon.lt.0.))) then
2964
9/18
✓ Branch 0 taken 30 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 30 times.
✓ Branch 4 taken 30 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 30 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 30 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 30 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 30 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 30 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 30 times.
30 allocate (work(imax,jmax))
2965
2966
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 30 times.
30 if(.not.ijordr) then
2967 do j=1,jmax
2968 do i=1,imax
2969 work(i,j) = data(j,i)
2970 enddo
2971 enddo
2972 else
2973
2/2
✓ Branch 0 taken 31080 times.
✓ Branch 1 taken 30 times.
31110 do j=1,jmax
2974
2/2
✓ Branch 0 taken 75388800 times.
✓ Branch 1 taken 31080 times.
75419910 do i=1,imax
2975
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 75388800 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 75388800 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 75388800 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 75388800 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 75388800 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 75388800 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 75388800 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 75388800 times.
75419880 work(i,j) = data(i,j)
2976 enddo
2977 enddo
2978 endif
2979
1/2
✓ Branch 0 taken 30 times.
✗ Branch 1 not taken.
30 if (dlat > 0.0) then
2980
1/2
✓ Branch 0 taken 30 times.
✗ Branch 1 not taken.
30 if (dlon > 0.0) then
2981
2/2
✓ Branch 0 taken 31080 times.
✓ Branch 1 taken 30 times.
31110 do j=1,jmax
2982 31080 jj = jmax - j + 1
2983
2/2
✓ Branch 0 taken 75388800 times.
✓ Branch 1 taken 31080 times.
75419910 do i=1,imax
2984
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 75388800 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 75388800 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 75388800 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 75388800 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 75388800 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 75388800 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 75388800 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 75388800 times.
75419880 data(i,jj) = work(i,j)
2985 enddo
2986 enddo
2987 else
2988 do i=1,imax
2989 data(imax-i+1,jj) = work(i,j)
2990 enddo
2991 endif
2992 else
2993 if (dlon > 0.0) then
2994 do j=1,jmax
2995 do i=1,imax
2996 data(i,j) = work(i,j)
2997 enddo
2998 enddo
2999 else
3000 do j=1,jmax
3001 do i=1,imax
3002 data(imax-i+1,j) = work(i,j)
3003 enddo
3004 enddo
3005 endif
3006 endif
3007
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 30 times.
30 deallocate (work, stat=iret)
3008 endif
3009 408 return
3010
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
204 end
3011 612 subroutine la2ga(regin,imxin,jmxin,rinlon,rinlat,rlon,rlat,inttyp,
3012 204 & gauout,len,lmask,rslmsk,slmask
3013 408 &, outlat, outlon,me)
3014 use machine , only : kind_io8,kind_io4
3015 implicit none
3016 408 real (kind=kind_io8) wei4,wei3,wei2,sum2,sum1,sum3,wei1,sum4,
3017 816 & wsum,tem,wsumiv,sums,sumn,wi2j2,x,y,wi1j1,
3018 408 & wi1j2,wi2j1,rlat,rlon,aphi,
3019 612 & rnume,alamd,denom
3020 816 integer jy,ifills,ix,len,inttyp,me,i,j,jmxin,imxin,jq,jx,j1,j2,
3021 816 & ii,i1,i2,kmami,it
3022 408 integer nx,kxs,kxt
3023 integer, allocatable, save :: imxnx(:)
3024 204 integer, allocatable :: ifill(:)
3025 !
3026 ! interpolation from lat/lon or gaussian grid to other lat/lon grid
3027 !
3028 real (kind=kind_io8) outlon(len),outlat(len),gauout(len),
3029 & slmask(len)
3030 real (kind=kind_io8) regin (imxin,jmxin),rslmsk(imxin,jmxin)
3031 !
3032 real (kind=kind_io8) rinlat(jmxin), rinlon(imxin)
3033
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 204 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 204 times.
✓ Branch 9 taken 470016 times.
✓ Branch 10 taken 204 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 204 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 204 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 204 times.
✓ Branch 20 taken 470016 times.
✓ Branch 21 taken 204 times.
612 integer iindx1(len), iindx2(len)
3034
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 204 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 204 times.
✓ Branch 9 taken 470016 times.
✓ Branch 10 taken 204 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 204 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 204 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 204 times.
✓ Branch 20 taken 470016 times.
✓ Branch 21 taken 204 times.
612 integer jindx1(len), jindx2(len)
3035
15/24
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 204 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 204 times.
✓ Branch 9 taken 470016 times.
✓ Branch 10 taken 204 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 204 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 204 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 204 times.
✓ Branch 20 taken 470016 times.
✓ Branch 21 taken 204 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 204 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 204 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 204 times.
✓ Branch 31 taken 470016 times.
✓ Branch 32 taken 204 times.
1224 real (kind=kind_io8) ddx(len), ddy(len), wrk(len)
3036 !
3037 logical lmask
3038 !
3039 logical first
3040 integer num_threads
3041 data first /.true./
3042 save num_threads, first
3043 !
3044 612 integer len_thread_m, len_thread, i1_t, i2_t
3045 integer num_parthds
3046 !
3047
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 198 times.
204 if (first) then
3048 6 num_threads = num_parthds()
3049 6 first = .false.
3050
8/16
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 6 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 6 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 6 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 6 times.
✗ Branch 16 not taken.
✓ Branch 17 taken 6 times.
6 if (.not. allocated(imxnx)) allocate (imxnx(num_threads))
3051 endif
3052 !
3053 ! if (me == 0) print *,' num_threads =',num_threads,' me=',me
3054 !
3055 ! if(me .eq. 0) then
3056 ! print *,'rlon=',rlon,' me=',me
3057 ! print *,'rlat=',rlat,' me=',me,' imxin=',imxin,' jmxin=',jmxin
3058 ! endif
3059 !
3060 ! do j=1,jmxin
3061 ! if(rlat.gt.0.) then
3062 ! rinlat(j) = rlat - float(j-1)*dlain
3063 ! else
3064 ! rinlat(j) = rlat + float(j-1)*dlain
3065 ! endif
3066 ! enddo
3067 !
3068 ! if (me .eq. 0) then
3069 ! print *,'rinlat='
3070 ! print *,(rinlat(j),j=1,jmxin)
3071 ! print *,'rinlon='
3072 ! print *,(rinlon(i),i=1,imxin)
3073 !
3074 ! print *,'outlat='
3075 ! print *,(outlat(j),j=1,len)
3076 ! print *,(outlon(j),j=1,len)
3077 ! endif
3078 !
3079 ! do i=1,imxin
3080 ! rinlon(i) = rlon + float(i-1)*dloin
3081 ! enddo
3082 !
3083 ! print *,'rinlon='
3084 ! print *,(rinlon(i),i=1,imxin)
3085 !
3086 204 len_thread_m = (len+num_threads-1) / num_threads
3087
3088
9/16
✓ Branch 0 taken 186 times.
✓ Branch 1 taken 18 times.
✓ Branch 2 taken 186 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 186 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 186 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 186 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 186 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 186 times.
✗ Branch 16 not taken.
✓ Branch 17 taken 186 times.
204 if (inttyp /=1) allocate (ifill(num_threads))
3089 !
3090 !$omp parallel do default(none)
3091 !$omp+private(i1_t,i2_t,len_thread,it,i,ii,i1,i2)
3092 !$omp+private(j,j1,j2,jq,ix,jy,nx,kxs,kxt,kmami)
3093 !$omp+private(alamd,denom,rnume,aphi,x,y,wsum,wsumiv,sum1,sum2)
3094 !$omp+private(sum3,sum4,wi1j1,wi2j1,wi1j2,wi2j2,wei1,wei2,wei3,wei4)
3095 !$omp+private(sumn,sums)
3096 !$omp+shared(imxin,jmxin,ifill)
3097 !$omp+shared(outlon,outlat,wrk,iindx1,rinlon,jindx1,rinlat,ddx,ddy)
3098 !$omp+shared(rlon,rlat,regin,gauout,imxnx)
3099 !$omp+private(tem)
3100 !$omp+shared(num_threads,len_thread_m,len,lmask,iindx2,jindx2,rslmsk)
3101 !$omp+shared(inttyp,me,slmask)
3102 !
3103
2/2
✓ Branch 0 taken 204 times.
✓ Branch 1 taken 204 times.
408 do it=1,num_threads ! start of threaded loop ...................
3104 204 i1_t = (it-1)*len_thread_m+1
3105
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
204 i2_t = min(i1_t+len_thread_m-1,len)
3106 204 len_thread = i2_t-i1_t+1
3107 !
3108 ! find i-index for interpolation
3109 !
3110
2/2
✓ Branch 0 taken 470016 times.
✓ Branch 1 taken 204 times.
470220 do i=i1_t, i2_t
3111
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 470016 times.
470016 alamd = outlon(i)
3112
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 470004 times.
470016 if (alamd .lt. rlon) alamd = alamd + 360.0
3113
2/2
✓ Branch 0 taken 34556 times.
✓ Branch 1 taken 435460 times.
470016 if (alamd .gt. 360.0+rlon) alamd = alamd - 360.0
3114
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 470016 times.
470016 wrk(i) = alamd
3115
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 470016 times.
470220 iindx1(i) = imxin
3116 enddo
3117
2/2
✓ Branch 0 taken 470016 times.
✓ Branch 1 taken 204 times.
470220 do i=i1_t,i2_t
3118
2/2
✓ Branch 0 taken 1106611200 times.
✓ Branch 1 taken 470016 times.
1107081420 do ii=1,imxin
3119
8/14
✗ Branch 0 not taken.
✓ Branch 1 taken 1106611200 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1106611200 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1106611200 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1106611200 times.
✓ Branch 12 taken 550628844 times.
✓ Branch 13 taken 555982356 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 550628844 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 550628844 times.
1107081216 if(wrk(i) .ge. rinlon(ii)) iindx1(i) = ii
3120 enddo
3121 enddo
3122
2/2
✓ Branch 0 taken 470016 times.
✓ Branch 1 taken 204 times.
470220 do i=i1_t,i2_t
3123
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 470016 times.
470016 i1 = iindx1(i)
3124
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
470016 if (i1 .lt. 1) i1 = imxin
3125 470016 i2 = i1 + 1
3126
2/2
✓ Branch 0 taken 440 times.
✓ Branch 1 taken 469576 times.
470016 if (i2 .gt. imxin) i2 = 1
3127
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 470016 times.
470016 iindx1(i) = i1
3128
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 470016 times.
470016 iindx2(i) = i2
3129
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 470016 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 470016 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 470016 times.
470016 denom = rinlon(i2) - rinlon(i1)
3130
2/2
✓ Branch 0 taken 440 times.
✓ Branch 1 taken 469576 times.
470016 if(denom.lt.0.) denom = denom + 360.
3131
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 470016 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 470016 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 470016 times.
470016 rnume = wrk(i) - rinlon(i1)
3132
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
470016 if(rnume.lt.0.) rnume = rnume + 360.
3133
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 470016 times.
470220 ddx(i) = rnume / denom
3134 enddo
3135 !
3136 ! find j-index for interplation
3137 !
3138
1/2
✓ Branch 0 taken 204 times.
✗ Branch 1 not taken.
204 if(rlat.gt.0.) then
3139
2/2
✓ Branch 0 taken 470016 times.
✓ Branch 1 taken 204 times.
470220 do j=i1_t,i2_t
3140
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 470016 times.
470220 jindx1(j)=0
3141 enddo
3142
2/2
✓ Branch 0 taken 240432 times.
✓ Branch 1 taken 204 times.
240636 do jx=1,jmxin
3143
2/2
✓ Branch 0 taken 553955328 times.
✓ Branch 1 taken 240432 times.
554195964 do j=i1_t,i2_t
3144
8/14
✗ Branch 0 not taken.
✓ Branch 1 taken 553955328 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 553955328 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 553955328 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 553955328 times.
✓ Branch 12 taken 276977664 times.
✓ Branch 13 taken 276977664 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 276977664 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 276977664 times.
554195760 if(outlat(j).le.rinlat(jx)) jindx1(j) = jx
3145 enddo
3146 enddo
3147
2/2
✓ Branch 0 taken 470016 times.
✓ Branch 1 taken 204 times.
470220 do j=i1_t,i2_t
3148
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 470016 times.
470016 jq = jindx1(j)
3149
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 470016 times.
470016 aphi=outlat(j)
3150
4/4
✓ Branch 0 taken 470008 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 470000 times.
✓ Branch 3 taken 8 times.
470016 if(jq.ge.1 .and. jq .lt. jmxin) then
3151 470000 j2=jq+1
3152 470000 j1=jq
3153
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 470000 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 470000 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 470000 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 470000 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 470000 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 470000 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 470000 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 470000 times.
470000 ddy(j)=(aphi-rinlat(j1))/(rinlat(j2)-rinlat(j1))
3154
2/2
✓ Branch 0 taken 8 times.
✓ Branch 1 taken 8 times.
16 elseif (jq .eq. 0) then
3155 8 j2=1
3156 8 j1=1
3157
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 8 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 8 times.
✓ Branch 6 taken 8 times.
✗ Branch 7 not taken.
8 if(abs(90.-rinlat(j1)).gt.0.001) then
3158
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 8 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 8 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 8 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 8 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 8 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 8 times.
8 ddy(j)=(aphi-rinlat(j1))/(90.-rinlat(j1))
3159 else
3160 ddy(j)=0.0
3161 endif
3162 else
3163 8 j2=jmxin
3164 8 j1=jmxin
3165
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 8 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 8 times.
✓ Branch 6 taken 8 times.
✗ Branch 7 not taken.
8 if(abs(-90.-rinlat(j1)).gt.0.001) then
3166
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 8 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 8 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 8 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 8 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 8 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 8 times.
8 ddy(j)=(aphi-rinlat(j1))/(-90.-rinlat(j1))
3167 else
3168 ddy(j)=0.0
3169 endif
3170 endif
3171
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 470016 times.
470016 jindx1(j)=j1
3172
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 470016 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 470016 times.
470220 jindx2(j)=j2
3173 enddo
3174 else
3175 do j=i1_t,i2_t
3176 jindx1(j) = jmxin+1
3177 enddo
3178 do jx=jmxin,1,-1
3179 do j=i1_t,i2_t
3180 if(outlat(j).le.rinlat(jx)) jindx1(j) = jx
3181 enddo
3182 enddo
3183 do j=i1_t,i2_t
3184 jq = jindx1(j)
3185 aphi=outlat(j)
3186 if(jq.gt.1 .and. jq .le. jmxin) then
3187 j2=jq
3188 j1=jq-1
3189 ddy(j)=(aphi-rinlat(j1))/(rinlat(j2)-rinlat(j1))
3190 elseif (jq .eq. 1) then
3191 j2=1
3192 j1=1
3193 if(abs(-90.-rinlat(j1)).gt.0.001) then
3194 ddy(j)=(aphi-rinlat(j1))/(-90.-rinlat(j1))
3195 else
3196 ddy(j)=0.0
3197 endif
3198 else
3199 j2=jmxin
3200 j1=jmxin
3201 if(abs(90.-rinlat(j1)).gt.0.001) then
3202 ddy(j)=(aphi-rinlat(j1))/(90.-rinlat(j1))
3203 else
3204 ddy(j)=0.0
3205 endif
3206 endif
3207 jindx1(j)=j1
3208 jindx2(j)=j2
3209 enddo
3210 endif
3211 !
3212 ! if (me .eq. 0 .and. inttyp .eq. 1) then
3213 ! print *,'la2ga'
3214 ! print *,'iindx1'
3215 ! print *,(iindx1(n),n=1,len)
3216 ! print *,'iindx2'
3217 ! print *,(iindx2(n),n=1,len)
3218 ! print *,'jindx1'
3219 ! print *,(jindx1(n),n=1,len)
3220 ! print *,'jindx2'
3221 ! print *,(jindx2(n),n=1,len)
3222 ! print *,'ddy'
3223 ! print *,(ddy(n),n=1,len)
3224 ! print *,'ddx'
3225 ! print *,(ddx(n),n=1,len)
3226 ! endif
3227 !
3228 204 sum1 = 0.
3229 204 sum2 = 0.
3230 204 sum3 = 0.
3231 204 sum4 = 0.
3232
2/2
✓ Branch 0 taken 180 times.
✓ Branch 1 taken 24 times.
204 if (lmask) then
3233 180 wei1 = 0.
3234 180 wei2 = 0.
3235 180 wei3 = 0.
3236 180 wei4 = 0.
3237
2/2
✓ Branch 0 taken 475152 times.
✓ Branch 1 taken 180 times.
475332 do i=1,imxin
3238
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 475152 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 475152 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 475152 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 475152 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 475152 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 475152 times.
475152 sum1 = sum1 + regin(i,1) * rslmsk(i,1)
3239
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 475152 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 475152 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 475152 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 475152 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 475152 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 475152 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 475152 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 475152 times.
475152 sum2 = sum2 + regin(i,jmxin) * rslmsk(i,jmxin)
3240
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 475152 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 475152 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 475152 times.
475152 wei1 = wei1 + rslmsk(i,1)
3241
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 475152 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 475152 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 475152 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 475152 times.
475152 wei2 = wei2 + rslmsk(i,jmxin)
3242 !
3243
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 475152 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 475152 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 475152 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 475152 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 475152 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 475152 times.
475152 sum3 = sum3 + regin(i,1) * (1.0-rslmsk(i,1))
3244
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 475152 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 475152 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 475152 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 475152 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 475152 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 475152 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 475152 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 475152 times.
475152 sum4 = sum4 + regin(i,jmxin) * (1.0-rslmsk(i,jmxin))
3245
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 475152 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 475152 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 475152 times.
475152 wei3 = wei3 + (1.0-rslmsk(i,1))
3246
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 475152 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 475152 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 475152 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 475152 times.
475332 wei4 = wei4 + (1.0-rslmsk(i,jmxin))
3247 enddo
3248 !
3249
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 180 times.
180 if(wei1.gt.0.) then
3250 sum1 = sum1 / wei1
3251 else
3252 180 sum1 = 0.
3253 endif
3254
2/2
✓ Branch 0 taken 132 times.
✓ Branch 1 taken 48 times.
180 if(wei2.gt.0.) then
3255 132 sum2 = sum2 / wei2
3256 else
3257 48 sum2 = 0.
3258 endif
3259
1/2
✓ Branch 0 taken 180 times.
✗ Branch 1 not taken.
180 if(wei3.gt.0.) then
3260 180 sum3 = sum3 / wei3
3261 else
3262 sum3 = 0.
3263 endif
3264
2/2
✓ Branch 0 taken 48 times.
✓ Branch 1 taken 132 times.
180 if(wei4.gt.0.) then
3265 48 sum4 = sum4 / wei4
3266 else
3267 132 sum4 = 0.
3268 endif
3269 else
3270
2/2
✓ Branch 0 taken 5148 times.
✓ Branch 1 taken 24 times.
5172 do i=1,imxin
3271
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 5148 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 5148 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 5148 times.
5148 sum1 = sum1 + regin(i,1)
3272
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 5148 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 5148 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 5148 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 5148 times.
5172 sum2 = sum2 + regin(i,jmxin)
3273 enddo
3274 24 sum1 = sum1 / imxin
3275 24 sum2 = sum2 / imxin
3276 24 sum3 = sum1
3277 24 sum4 = sum2
3278 endif
3279 !
3280 ! print *,' sum1=',sum1,' sum2=',sum2
3281 ! *,' sum3=',sum3,' sum4=',sum4
3282 ! print *,' rslmsk=',(rslmsk(i,1),i=1,imxin)
3283 ! print *,' slmask=',(slmask(i),i=1,imxout)
3284 ! *,' j1=',jindx1(1),' j2=',jindx2(1)
3285 !
3286 !
3287 ! inttyp=1 take the closest point value
3288 !
3289
2/2
✓ Branch 0 taken 18 times.
✓ Branch 1 taken 186 times.
408 if(inttyp.eq.1) then
3290
3291
2/2
✓ Branch 0 taken 41472 times.
✓ Branch 1 taken 18 times.
41490 do i=i1_t,i2_t
3292
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 41472 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 41472 times.
41472 jy = jindx1(i)
3293
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 41472 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 41472 times.
✓ Branch 6 taken 20736 times.
✓ Branch 7 taken 20736 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 20736 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 20736 times.
41472 if(ddy(i) .ge. 0.5) jy = jindx2(i)
3294
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 41472 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 41472 times.
41472 ix = iindx1(i)
3295
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 41472 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 41472 times.
✓ Branch 6 taken 20547 times.
✓ Branch 7 taken 20925 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 20547 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 20547 times.
41472 if(ddx(i) .ge. 0.5) ix = iindx2(i)
3296 !
3297 !cggg start
3298 !
3299
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 41472 times.
41490 if (.not. lmask) then
3300
3301 gauout(i) = regin(ix,jy)
3302
3303 else
3304
3305
8/14
✗ Branch 0 not taken.
✓ Branch 1 taken 41472 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 41472 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 41472 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 41472 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 41472 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 41472 times.
✓ Branch 18 taken 40878 times.
✓ Branch 19 taken 594 times.
41472 if(slmask(i).eq.rslmsk(ix,jy)) then
3306
3307
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 40878 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 40878 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 40878 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 40878 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 40878 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 40878 times.
40878 gauout(i) = regin(ix,jy)
3308
3309 else
3310
3311 594 i1 = ix
3312 594 j1 = jy
3313
3314 ! spiral around until matching mask is found.
3315
1/2
✓ Branch 0 taken 4842 times.
✗ Branch 1 not taken.
4842 do nx=1,jmxin*imxin/2
3316 4842 kxs=sqrt(4*nx-2.5)
3317 4842 kxt=nx-int(kxs**2/4+1)
3318 6276 select case(mod(kxs,4))
3319 case(1)
3320 1434 ix=i1-kxs/4+kxt
3321 1434 jx=j1-kxs/4
3322 case(2)
3323 1197 ix=i1+1+kxs/4
3324 1197 jx=j1-kxs/4+kxt
3325 case(3)
3326 1270 ix=i1+1+kxs/4-kxt
3327 1270 jx=j1+1+kxs/4
3328 case default
3329 941 ix=i1-kxs/4
3330
4/4
✓ Branch 0 taken 1434 times.
✓ Branch 1 taken 1197 times.
✓ Branch 2 taken 1270 times.
✓ Branch 3 taken 941 times.
5783 jx=j1+kxs/4-kxt
3331 end select
3332
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 4842 times.
4842 if(jx.lt.1) then
3333 ix=ix+imxin/2
3334 jx=2-jx
3335
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 4842 times.
4842 elseif(jx.gt.jmxin) then
3336 ix=ix+imxin/2
3337 jx=2*jmxin-jx
3338 endif
3339 4842 ix=modulo(ix-1,imxin)+1
3340
8/14
✗ Branch 0 not taken.
✓ Branch 1 taken 4842 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4842 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4842 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4842 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4842 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4842 times.
✓ Branch 18 taken 594 times.
✓ Branch 19 taken 4248 times.
4842 if(slmask(i).eq.rslmsk(ix,jx)) then
3341
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 594 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 594 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 594 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 594 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 594 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 594 times.
594 gauout(i) = regin(ix,jx)
3342 594 go to 81
3343 endif
3344 enddo
3345
3346 !cggg here, set the gauout value to be 0, and let's sarah's land
3347 !cggg routine assign a default.
3348
3349 if (num_threads == 1) then
3350 print*,'no matching mask found ',i,i1,j1,ix,jx
3351 print*,'set to default value.'
3352 endif
3353 gauout(i) = 0.0
3354
3355
3356 81 continue
3357
3358 end if
3359
3360 end if
3361
3362 !cggg end
3363
3364 enddo
3365 ! kmami=1
3366 ! if (me == 0 .and. num_threads == 1)
3367 ! & call maxmin(gauout(i1_t),len_thread,kmami)
3368 else ! nearest neighbor interpolation
3369
3370 !
3371 ! quasi-bilinear interpolation
3372 !
3373
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 186 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 186 times.
186 ifill(it) = 0
3374
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 186 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 186 times.
186 imxnx(it) = 0
3375
2/2
✓ Branch 0 taken 428544 times.
✓ Branch 1 taken 186 times.
428730 do i=i1_t,i2_t
3376
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 428544 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 428544 times.
428544 y = ddy(i)
3377
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 428544 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 428544 times.
428544 j1 = jindx1(i)
3378
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 428544 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 428544 times.
428544 j2 = jindx2(i)
3379
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 428544 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 428544 times.
428544 x = ddx(i)
3380
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 428544 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 428544 times.
428544 i1 = iindx1(i)
3381
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 428544 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 428544 times.
428544 i2 = iindx2(i)
3382 !
3383 428544 wi1j1 = (1.-x) * (1.-y)
3384 428544 wi2j1 = x *( 1.-y)
3385 428544 wi1j2 = (1.-x) * y
3386 428544 wi2j2 = x * y
3387 !
3388
10/20
✗ Branch 0 not taken.
✓ Branch 1 taken 428544 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 428544 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 428544 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 428544 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 428544 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 428544 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 428544 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 428544 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 428544 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 428544 times.
428544 tem = 4.*slmask(i) - rslmsk(i1,j1) - rslmsk(i2,j1)
3389
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 428544 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 428544 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 428544 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 428544 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 428544 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 428544 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 428544 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 428544 times.
428544 & - rslmsk(i1,j2) - rslmsk(i2,j2)
3390
4/4
✓ Branch 0 taken 373248 times.
✓ Branch 1 taken 55296 times.
✓ Branch 2 taken 10475 times.
✓ Branch 3 taken 362773 times.
428544 if(lmask .and. abs(tem) .gt. 0.01) then
3391
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 10475 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 10475 times.
✓ Branch 6 taken 5021 times.
✓ Branch 7 taken 5454 times.
10475 if(slmask(i).eq.1.) then
3392
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 5021 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 5021 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 5021 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 5021 times.
5021 wi1j1 = wi1j1 * rslmsk(i1,j1)
3393
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 5021 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 5021 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 5021 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 5021 times.
5021 wi2j1 = wi2j1 * rslmsk(i2,j1)
3394
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 5021 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 5021 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 5021 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 5021 times.
5021 wi1j2 = wi1j2 * rslmsk(i1,j2)
3395
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 5021 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 5021 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 5021 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 5021 times.
5021 wi2j2 = wi2j2 * rslmsk(i2,j2)
3396 else
3397
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 5454 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 5454 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 5454 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 5454 times.
5454 wi1j1 = wi1j1 * (1.0-rslmsk(i1,j1))
3398
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 5454 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 5454 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 5454 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 5454 times.
5454 wi2j1 = wi2j1 * (1.0-rslmsk(i2,j1))
3399
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 5454 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 5454 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 5454 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 5454 times.
5454 wi1j2 = wi1j2 * (1.0-rslmsk(i1,j2))
3400
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 5454 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 5454 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 5454 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 5454 times.
5454 wi2j2 = wi2j2 * (1.0-rslmsk(i2,j2))
3401 endif
3402 endif
3403 !
3404 428544 wsum = wi1j1 + wi2j1 + wi1j2 + wi2j2
3405
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 428544 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 428544 times.
428544 wrk(i) = wsum
3406
2/2
✓ Branch 0 taken 425901 times.
✓ Branch 1 taken 2643 times.
428730 if(wsum.ne.0.) then
3407 425901 wsumiv = 1./wsum
3408 !
3409
2/2
✓ Branch 0 taken 425885 times.
✓ Branch 1 taken 16 times.
425901 if(j1.ne.j2) then
3410
10/20
✗ Branch 0 not taken.
✓ Branch 1 taken 425885 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 425885 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 425885 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 425885 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 425885 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 425885 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 425885 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 425885 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 425885 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 425885 times.
425885 gauout(i) = (wi1j1*regin(i1,j1) + wi2j1*regin(i2,j1) +
3411
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 425885 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 425885 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 425885 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 425885 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 425885 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 425885 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 425885 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 425885 times.
425885 & wi1j2*regin(i1,j2) + wi2j2*regin(i2,j2))
3412 425885 & *wsumiv
3413 else
3414 !
3415
1/2
✓ Branch 0 taken 16 times.
✗ Branch 1 not taken.
16 if (rlat .gt. 0.0) then
3416
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 16 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 16 times.
✓ Branch 6 taken 8 times.
✓ Branch 7 taken 8 times.
16 if (slmask(i) .eq. 1.0) then
3417 8 sumn = sum1
3418 8 sums = sum2
3419 else
3420 8 sumn = sum3
3421 8 sums = sum4
3422 endif
3423
2/2
✓ Branch 0 taken 8 times.
✓ Branch 1 taken 8 times.
16 if( j1 .eq. 1) then
3424
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 8 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 8 times.
8 gauout(i) = (wi1j1*sumn +wi2j1*sumn +
3425
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 8 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 8 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 8 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 8 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 8 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 8 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 8 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 8 times.
8 & wi1j2*regin(i1,j2)+wi2j2*regin(i2,j2))
3426 8 & * wsumiv
3427
1/2
✓ Branch 0 taken 8 times.
✗ Branch 1 not taken.
8 elseif (j1 .eq. jmxin) then
3428
10/20
✗ Branch 0 not taken.
✓ Branch 1 taken 8 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 8 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 8 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 8 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 8 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 8 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 8 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 8 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 8 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 8 times.
8 gauout(i) = (wi1j1*regin(i1,j1)+wi2j1*regin(i2,j1)+
3429 & wi1j2*sums +wi2j2*sums )
3430 8 & * wsumiv
3431 endif
3432 ! print *,' slmask=',slmask(i),' sums=',sums,' sumn=',sumn
3433 ! & ,' regin=',regin(i1,j2),regin(i2,j2),' j1=',j1,' j2=',j2
3434 ! & ,' wij=',wi1j1, wi2j1, wi1j2, wi2j2,wsumiv
3435 else
3436 if (slmask(i) .eq. 1.0) then
3437 sums = sum1
3438 sumn = sum2
3439 else
3440 sums = sum3
3441 sumn = sum4
3442 endif
3443 if( j1 .eq. 1) then
3444 gauout(i) = (wi1j1*regin(i1,j1)+wi2j1*regin(i2,j1)+
3445 & wi1j2*sums +wi2j2*sums )
3446 & * wsumiv
3447 elseif (j1 .eq. jmxin) then
3448 gauout(i) = (wi1j1*sumn +wi2j1*sumn +
3449 & wi1j2*regin(i1,j2)+wi2j2*regin(i2,j2))
3450 & * wsumiv
3451 endif
3452 endif
3453 endif ! if j1 .ne. j2
3454 endif
3455 enddo
3456
2/2
✓ Branch 0 taken 428544 times.
✓ Branch 1 taken 186 times.
428730 do i=i1_t,i2_t
3457
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 428544 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 428544 times.
428544 j1 = jindx1(i)
3458
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 428544 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 428544 times.
428544 j2 = jindx2(i)
3459
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 428544 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 428544 times.
428544 i1 = iindx1(i)
3460
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 428544 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 428544 times.
428544 i2 = iindx2(i)
3461
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 428544 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 428544 times.
✓ Branch 6 taken 2643 times.
✓ Branch 7 taken 425901 times.
428730 if(wrk(i) .eq. 0.0) then
3462
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2643 times.
2643 if(.not.lmask) then
3463 if (num_threads == 1)
3464 & write(6,*) ' la2ga called with lmask=.true. but bad',
3465 & ' rslmsk or slmask given'
3466 call abort
3467 endif
3468
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 2643 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 2643 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 2643 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 2643 times.
2643 ifill(it) = ifill(it) + 1
3469
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 2643 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 2643 times.
✓ Branch 6 taken 312 times.
✓ Branch 7 taken 2331 times.
2643 if(ifill(it) <= 2 ) then
3470
3/4
✓ Branch 0 taken 52 times.
✓ Branch 1 taken 260 times.
✓ Branch 2 taken 52 times.
✗ Branch 3 not taken.
312 if (me == 0 .and. num_threads == 1) then
3471 52 write(6,*) 'i1,i2,j1,j2=',i1,i2,j1,j2
3472
12/24
✗ Branch 1 not taken.
✓ Branch 2 taken 52 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 52 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 52 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 52 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 52 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 52 times.
✗ Branch 20 not taken.
✓ Branch 21 taken 52 times.
✗ Branch 23 not taken.
✓ Branch 24 taken 52 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 52 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 52 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 52 times.
✗ Branch 36 not taken.
✓ Branch 37 taken 52 times.
52 write(6,*) 'rslmsk=',rslmsk(i1,j1),rslmsk(i1,j2),
3473
4/8
✗ Branch 2 not taken.
✓ Branch 3 taken 52 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 52 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 52 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 52 times.
104 & rslmsk(i2,j1),rslmsk(i2,j2)
3474 ! write(6,*) 'i,j=',i,j,' slmask(i)=',slmask(i)
3475
2/4
✗ Branch 3 not taken.
✓ Branch 4 taken 52 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 52 times.
52 write(6,*) 'i=',i,' slmask(i)=',slmask(i)
3476
4/8
✗ Branch 2 not taken.
✓ Branch 3 taken 52 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 52 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 52 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 52 times.
104 &, ' outlon=',outlon(i),' outlat=',outlat(i)
3477 endif
3478 endif
3479 ! spiral around until matching mask is found.
3480
1/2
✓ Branch 0 taken 64391 times.
✗ Branch 1 not taken.
64391 do nx=1,jmxin*imxin/2
3481 64391 kxs=sqrt(4*nx-2.5)
3482 64391 kxt=nx-int(kxs**2/4+1)
3483 81754 select case(mod(kxs,4))
3484 case(1)
3485 17363 ix=i1-kxs/4+kxt
3486 17363 jx=j1-kxs/4
3487 case(2)
3488 15059 ix=i1+1+kxs/4
3489 15059 jx=j1-kxs/4+kxt
3490 case(3)
3491 17251 ix=i1+1+kxs/4-kxt
3492 17251 jx=j1+1+kxs/4
3493 case default
3494 14718 ix=i1-kxs/4
3495
4/4
✓ Branch 0 taken 17363 times.
✓ Branch 1 taken 15059 times.
✓ Branch 2 taken 17251 times.
✓ Branch 3 taken 14718 times.
79109 jx=j1+kxs/4-kxt
3496 end select
3497
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 64391 times.
64391 if(jx.lt.1) then
3498 ix=ix+imxin/2
3499 jx=2-jx
3500
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 64391 times.
64391 elseif(jx.gt.jmxin) then
3501 ix=ix+imxin/2
3502 jx=2*jmxin-jx
3503 endif
3504 64391 ix=modulo(ix-1,imxin)+1
3505
8/14
✗ Branch 0 not taken.
✓ Branch 1 taken 64391 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 64391 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 64391 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 64391 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 64391 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 64391 times.
✓ Branch 18 taken 2643 times.
✓ Branch 19 taken 61748 times.
64391 if(slmask(i).eq.rslmsk(ix,jx)) then
3506
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 2643 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 2643 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 2643 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 2643 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 2643 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 2643 times.
2643 gauout(i) = regin(ix,jx)
3507
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 2643 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 2643 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 2643 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 2643 times.
✓ Branch 12 taken 542 times.
✓ Branch 13 taken 2101 times.
2643 imxnx(it) = max(imxnx(it),nx)
3508 2643 go to 71
3509 endif
3510 enddo
3511 !
3512 if (num_threads == 1) then
3513 write(6,*) ' error!!! no filling value found in la2ga'
3514 ! write(6,*) ' i ix jx slmask(i) rslmsk ',
3515 ! & i,ix,jx,slmask(i),rslmsk(ix,jx)
3516 endif
3517 call abort
3518 !
3519 71 continue
3520 endif
3521 !
3522 enddo
3523 endif
3524 enddo ! end of threaded loop ...................
3525 !$omp end parallel do
3526 !
3527
2/2
✓ Branch 0 taken 186 times.
✓ Branch 1 taken 18 times.
204 if(inttyp /= 1)then
3528 186 ifills = 0
3529
2/2
✓ Branch 0 taken 186 times.
✓ Branch 1 taken 186 times.
372 do it=1,num_threads
3530
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 186 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 186 times.
372 ifills = ifills + ifill(it)
3531 enddo
3532
3533
2/2
✓ Branch 0 taken 154 times.
✓ Branch 1 taken 32 times.
186 if(ifills.gt.1) then
3534
2/2
✓ Branch 0 taken 25 times.
✓ Branch 1 taken 129 times.
154 if (me .eq. 0) then
3535 25 write(6,*) ' unable to interpolate. filled with nearest',
3536 50 & ' point value at ',ifills,' points'
3537 ! & ' point value at ',ifills,' points imxnx=',imxnx(:)
3538 endif
3539 endif
3540
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 186 times.
186 deallocate (ifill)
3541 endif
3542 !
3543 ! kmami = 1
3544 ! if (me == 0) call maxmin(gauout,len,kmami)
3545 !
3546 408 return
3547
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
204 end subroutine la2ga
3548 subroutine maxmin(f,imax,kmax)
3549 use machine , only : kind_io8,kind_io4
3550 implicit none
3551 integer i,iimin,iimax,kmax,imax,k
3552 real (kind=kind_io8) fmin,fmax
3553 !
3554 real (kind=kind_io8) f(imax,kmax)
3555 !
3556 do k=1,kmax
3557 !
3558 fmax = f(1,k)
3559 fmin = f(1,k)
3560 !
3561 do i=1,imax
3562 if(fmax.le.f(i,k)) then
3563 fmax = f(i,k)
3564 iimax = i
3565 endif
3566 if(fmin.ge.f(i,k)) then
3567 fmin = f(i,k)
3568 iimin = i
3569 endif
3570 enddo
3571 !
3572 ! write(6,100) k,fmax,iimax,fmin,iimin
3573 ! 100 format(2x,'level=',i2,' max=',e11.4,' at i=',i7,
3574 ! & ' min=',e11.4,' at i=',i7)
3575 !
3576 enddo
3577 !
3578 return
3579 end
3580 36 subroutine filanl(tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl,
3581 6 & aisanl,
3582 24 & tg3anl,cvanl ,cvbanl,cvtanl,
3583 36 & cnpanl,smcanl,stcanl,slianl,scvanl,veganl,
3584 18 & vetanl,sotanl,alfanl,
3585 !cwu [+1l] add ()anl for sih, sic
3586 12 & sihanl,sicanl,
3587 !clu [+1l] add ()anl for vmn, vmx, slp, abs
3588 24 & vmnanl,vmxanl,slpanl,absanl,
3589 36 & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm,
3590 6 & aisclm,
3591 24 & tg3clm,cvclm ,cvbclm,cvtclm,
3592 36 & cnpclm,smcclm,stcclm,sliclm,scvclm,vegclm,
3593 18 & vetclm,sotclm,alfclm,
3594 !cwu [+1l] add ()clm for sih, sic
3595 12 & sihclm,sicclm,
3596 !clu [+1l] add ()clm for vmn, vmx, slp, abs
3597 24 & vmnclm,vmxclm,slpclm,absclm,
3598 & len,lsoil)
3599 use machine , only : kind_io8,kind_io4
3600 implicit none
3601 6 integer i,j,len,lsoil
3602 !
3603 real (kind=kind_io8) tsfanl(len),tsfan2(len),wetanl(len),
3604 & snoanl(len),
3605 & zoranl(len),albanl(len,4),aisanl(len),
3606 & tg3anl(len),
3607 & cvanl (len),cvbanl(len),cvtanl(len),
3608 & cnpanl(len),
3609 & smcanl(len,lsoil),stcanl(len,lsoil),
3610 & slianl(len),scvanl(len),veganl(len),
3611 & vetanl(len),sotanl(len),alfanl(len,2)
3612 !cwu [+1l] add ()anl for sih, sic
3613 &, sihanl(len),sicanl(len)
3614 !clu [+1l] add ()anl for vmn, vmx, slp, abs
3615 &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len)
3616 real (kind=kind_io8) tsfclm(len),tsfcl2(len),wetclm(len),
3617 & snoclm(len),
3618 & zorclm(len),albclm(len,4),aisclm(len),
3619 & tg3clm(len),
3620 & cvclm (len),cvbclm(len),cvtclm(len),
3621 & cnpclm(len),
3622 & smcclm(len,lsoil),stcclm(len,lsoil),
3623 & sliclm(len),scvclm(len),vegclm(len),
3624 & vetclm(len),sotclm(len),alfclm(len,2)
3625 !cwu [+1l] add ()clm for sih, sic
3626 &, sihclm(len),sicclm(len)
3627 !clu [+1l] add ()clm for vmn, vmx, slp, abs
3628 &, vmnclm(len),vmxclm(len),slpclm(len),absclm(len)
3629 !
3630
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
3631
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 tsfanl(i) = tsfclm(i) ! tsf at t
3632
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 tsfan2(i) = tsfcl2(i) ! tsf at t-deltsfc
3633
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 wetanl(i) = wetclm(i) ! soil wetness
3634
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 snoanl(i) = snoclm(i) ! snow
3635
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 scvanl(i) = scvclm(i) ! snow cover
3636
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 aisanl(i) = aisclm(i) ! seaice
3637
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 slianl(i) = sliclm(i) ! land/sea/snow mask
3638
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 zoranl(i) = zorclm(i) ! surface roughness
3639 ! plranl(i) = plrclm(i) ! maximum stomatal resistance
3640
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 tg3anl(i) = tg3clm(i) ! deep soil temperature
3641
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 cnpanl(i) = cnpclm(i) ! canopy water content
3642
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 veganl(i) = vegclm(i) ! vegetation cover
3643
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 vetanl(i) = vetclm(i) ! vegetation type
3644
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 sotanl(i) = sotclm(i) ! soil type
3645
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 cvanl(i) = cvclm(i) ! cv
3646
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 cvbanl(i) = cvbclm(i) ! cvb
3647
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 cvtanl(i) = cvtclm(i) ! cvt
3648 !cwu [+4l] add sih, sic
3649
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 sihanl(i) = sihclm(i) ! sea ice thickness
3650
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 sicanl(i) = sicclm(i) ! sea ice concentration
3651 !clu [+4l] add vmn, vmx, slp, abs
3652
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 vmnanl(i) = vmnclm(i) ! min vegetation cover
3653
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 vmxanl(i) = vmxclm(i) ! max vegetation cover
3654
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 slpanl(i) = slpclm(i) ! slope type
3655
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 absanl(i) = absclm(i) ! max snow albedo
3656 enddo
3657 !
3658
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do j=1,lsoil
3659
2/2
✓ Branch 0 taken 55296 times.
✓ Branch 1 taken 24 times.
55326 do i=1,len
3660
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 55296 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 55296 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 55296 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 55296 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 55296 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 55296 times.
55296 smcanl(i,j) = smcclm(i,j) ! layer soil wetness
3661
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 55296 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 55296 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 55296 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 55296 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 55296 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 55296 times.
55320 stcanl(i,j) = stcclm(i,j) ! soil temperature
3662 enddo
3663 enddo
3664
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do j=1,4
3665
2/2
✓ Branch 0 taken 55296 times.
✓ Branch 1 taken 24 times.
55326 do i=1,len
3666
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 55296 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 55296 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 55296 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 55296 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 55296 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 55296 times.
55320 albanl(i,j) = albclm(i,j) ! albedo
3667 enddo
3668 enddo
3669
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 6 times.
18 do j=1,2
3670
2/2
✓ Branch 0 taken 27648 times.
✓ Branch 1 taken 12 times.
27666 do i=1,len
3671
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 27648 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 27648 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 27648 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 27648 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 27648 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 27648 times.
27660 alfanl(i,j) = alfclm(i,j) ! vegetation fraction for albedo
3672 enddo
3673 enddo
3674 !
3675 6 return
3676 end
3677 6 subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil,
3678
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
12 & slmask,fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa,
3679
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
6 & fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega,
3680
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 & fnveta,fnsota,
3681 !clu [+1l] add fn()a for vmn, vmx, slp, abs
3682
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
6 & fnvmna,fnvmxa,fnslpa,fnabsa,
3683 30 & tsfanl,wetanl,snoanl,zoranl,albanl,aisanl,
3684 6 & tg3anl,cvanl ,cvbanl,cvtanl,
3685 18 & smcanl,stcanl,slianl,scvanl,acnanl,veganl,
3686 18 & vetanl,sotanl,alfanl,tsfan0,
3687 !clu [+1l] add ()anl for vmn, vmx, slp, abs
3688 6 & vmnanl,vmxanl,slpanl,absanl,
3689 !cggg snow mods start & kpdtsf,kpdwet,kpdsno,kpdzor,kpdalb,kpdais,
3690 & kpdtsf,kpdwet,kpdsno,kpdsnd,kpdzor,kpdalb,kpdais,
3691 !cggg snow mods end
3692 & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg,
3693 & kprvet,kpdsot,kpdalf,
3694 !clu [+1l] add kpd() for vmn, vmx, slp, abs
3695 & kpdvmn,kpdvmx,kpdslp,kpdabs,
3696 & irttsf,irtwet,irtsno,irtzor,irtalb,irtais,
3697 & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg,
3698 & irtvet,irtsot,irtalf
3699 !clu [+1l] add irt() for vmn, vmx, slp, abs
3700 &, irtvmn,irtvmx,irtslp,irtabs
3701 6 &, imsk, jmsk, slmskh, outlat, outlon
3702 &, gaus, blno, blto, me, lanom)
3703 use machine , only : kind_io8,kind_io4
3704 implicit none
3705 logical lanom
3706 integer irtsmc,irtacn,irtstc,irtvet,irtveg,irtscv,irtzor,irtsno,
3707 18 & irtalb,irttg3,irtais,iret,me,kk,kpdvet,i,irtalf,irtsot,
3708 !cggg snow mods start & imsk,jmsk,irtwet,lsoil,len, kpdtsf,kpdsno,kpdwet,iy,
3709 & imsk,jmsk,irtwet,lsoil,len,kpdtsf,kpdsno,kpdsnd,kpdwet,iy,
3710 !cggg snow mods end
3711 & lugb,im,ih,id,kpdveg,kpdstc,kprvet,irttsf,kpdsot,kpdsmc,
3712 & kpdais,kpdzor,kpdtg3,kpdacn,kpdscv,j
3713 !clu [+1l] add kpd() and irt() for vmn, vmx, slp, abs
3714 &, kpdvmn,kpdvmx,kpdslp,kpdabs,irtvmn,irtvmx,irtslp,irtabs
3715 real (kind=kind_io8) blto,blno,fh
3716 !
3717 real (kind=kind_io8) slmask(len)
3718 real (kind=kind_io8) slmskh(imsk,jmsk)
3719 real (kind=kind_io8) outlat(len), outlon(len)
3720 integer kpdalb(4), kpdalf(2)
3721 !cggg snow mods start
3722
8/8
✓ Branch 0 taken 6000 times.
✓ Branch 1 taken 6 times.
✓ Branch 2 taken 6000 times.
✓ Branch 3 taken 6 times.
✓ Branch 4 taken 6000 times.
✓ Branch 5 taken 6 times.
✓ Branch 6 taken 6000 times.
✓ Branch 7 taken 6 times.
12 integer kpds(1000),kgds(1000),jpds(1000),jgds(1000)
3723 6 integer lugi, lskip, lgrib, ndata
3724 !cggg snow mods end
3725 !
3726 character*500 fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa,
3727 & fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega,
3728 & fnveta,fnsota
3729 !clu [+1l] add fn()a for vmn, vmx, slp, abs
3730 &, fnvmna,fnvmxa,fnslpa,fnabsa
3731
3732 real (kind=kind_io8) tsfanl(len), wetanl(len), snoanl(len),
3733 & zoranl(len), albanl(len,4), aisanl(len),
3734 & tg3anl(len), acnanl(len),
3735 & cvanl (len), cvbanl(len), cvtanl(len),
3736 & slianl(len), scvanl(len), veganl(len),
3737 & vetanl(len), sotanl(len), alfanl(len,2),
3738 & smcanl(len,lsoil), stcanl(len,lsoil),
3739 & tsfan0(len)
3740 !clu [+1l] add ()anl for vmn, vmx, slp, abs
3741 &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len)
3742 !
3743 logical gaus
3744 !
3745 ! tsf
3746 !
3747 6 irttsf = 1
3748
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fntsfa(1:8).ne.' ') then
3749 call fixrda(lugb,fntsfa,kpdtsf,slmask,
3750 & iy,im,id,ih,fh,tsfanl,len,iret
3751 &, imsk, jmsk, slmskh, gaus,blno, blto
3752 &, outlat, outlon, me)
3753 irttsf = iret
3754 if(iret == 1) then
3755 write(6,*) 't surface analysis read error'
3756 call abort
3757 elseif(iret == -1) then
3758 if (me == 0) then
3759 print *,'old t surface analysis provided, indicating proper'
3760 &, ' file name is given. no error suspected.'
3761 write(6,*) 'forecast guess will be used'
3762 endif
3763 else
3764 if (me == 0) print *,'t surface analysis provided.'
3765 endif
3766 else
3767
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me == 0) then
3768 ! print *,'************************************************'
3769 1 print *,'no tsf analysis available. climatology used'
3770 endif
3771 endif
3772 !
3773 ! tsf0
3774 !
3775
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
6 if(fntsfa(1:8).ne.' ' .and. lanom) then
3776 call fixrda(lugb,fntsfa,kpdtsf,slmask,
3777 & iy,im,id,ih,0.,tsfan0,len,iret
3778 &, imsk, jmsk, slmskh, gaus,blno, blto
3779 &, outlat, outlon, me)
3780 if(iret == 1) then
3781 write(6,*) 't surface at ft=0 analysis read error'
3782 call abort
3783 elseif(iret == -1) then
3784 if (me == 0) then
3785 write(6,*) 'could not find t surface analysis at ft=0'
3786 endif
3787 call abort
3788 else
3789 print *,'t surface analysis at ft=0 found.'
3790 endif
3791 else
3792
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
3793
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13830 tsfan0(i)=-999.9
3794 enddo
3795 endif
3796 !
3797 ! albedo
3798 !
3799 6 irtalb=0
3800
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnalba(1:8).ne.' ') then
3801 do kk = 1, 4
3802 call fixrda(lugb,fnalba,kpdalb(kk),slmask,
3803 & iy,im,id,ih,fh,albanl(1,kk),len,iret
3804 &, imsk, jmsk, slmskh, gaus,blno, blto
3805 &, outlat, outlon, me)
3806 irtalb=iret
3807 if(iret.eq.1) then
3808 write(6,*) 'albedo analysis read error'
3809 call abort
3810 elseif(iret.eq.-1) then
3811 if (me .eq. 0) then
3812 print *,'old albedo analysis provided, indicating proper',
3813 & ' file name is given. no error suspected.'
3814 write(6,*) 'forecast guess will be used'
3815 endif
3816 else
3817 if (me .eq. 0 .and. kk .eq. 4)
3818 & print *,'albedo analysis provided.'
3819 endif
3820 enddo
3821 else
3822
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
3823 ! print *,'************************************************'
3824 1 print *,'no albedo analysis available. climatology used'
3825 endif
3826 endif
3827 !
3828 ! vegetation fraction for albedo
3829 !
3830 6 irtalf=0
3831
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnalba(1:8).ne.' ') then
3832 do kk = 1, 2
3833 call fixrda(lugb,fnalba,kpdalf(kk),slmask,
3834 & iy,im,id,ih,fh,alfanl(1,kk),len,iret
3835 &, imsk, jmsk, slmskh, gaus,blno, blto
3836 &, outlat, outlon, me)
3837 irtalf=iret
3838 if(iret.eq.1) then
3839 write(6,*) 'albedo analysis read error'
3840 call abort
3841 elseif(iret.eq.-1) then
3842 if (me .eq. 0) then
3843 print *,'old albedo analysis provided, indicating proper',
3844 & ' file name is given. no error suspected.'
3845 write(6,*) 'forecast guess will be used'
3846 endif
3847 else
3848 if (me .eq. 0 .and. kk .eq. 4)
3849 & print *,'albedo analysis provided.'
3850 endif
3851 enddo
3852 else
3853
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
3854 ! print *,'************************************************'
3855 1 print *,'no vegfalbedo analysis available. climatology used'
3856 endif
3857 endif
3858 !
3859 ! soil wetness
3860 !
3861 6 irtwet=0
3862 6 irtsmc=0
3863
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnweta(1:8).ne.' ') then
3864 call fixrda(lugb,fnweta,kpdwet,slmask,
3865 & iy,im,id,ih,fh,wetanl,len,iret
3866 &, imsk, jmsk, slmskh, gaus,blno, blto
3867 &, outlat, outlon, me)
3868 irtwet=iret
3869 if(iret.eq.1) then
3870 write(6,*) 'bucket wetness analysis read error'
3871 call abort
3872 elseif(iret.eq.-1) then
3873 if (me .eq. 0) then
3874 print *,'old wetness analysis provided, indicating proper',
3875 & ' file name is given. no error suspected.'
3876 write(6,*) 'forecast guess will be used'
3877 endif
3878 else
3879 if (me .eq. 0) print *,'bucket wetness analysis provided.'
3880 endif
3881
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 elseif(fnsmca(1:8).ne.' ') then
3882 call fixrda(lugb,fnsmca,kpdsmc,slmask,
3883 & iy,im,id,ih,fh,smcanl(1,1),len,iret
3884 &, imsk, jmsk, slmskh, gaus,blno, blto
3885 &, outlat, outlon, me)
3886 call fixrda(lugb,fnsmca,kpdsmc,slmask,
3887 & iy,im,id,ih,fh,smcanl(1,2),len,iret
3888 &, imsk, jmsk, slmskh, gaus,blno, blto
3889 &, outlat, outlon, me)
3890 irtsmc=iret
3891 if(iret.eq.1) then
3892 write(6,*) 'layer soil wetness analysis read error'
3893 call abort
3894 elseif(iret.eq.-1) then
3895 if (me .eq. 0) then
3896 print *,'old layer soil wetness analysis provided',
3897 & ' indicating proper file name is given.'
3898 print *,' no error suspected.'
3899 write(6,*) 'forecast guess will be used'
3900 endif
3901 else
3902 if (me .eq. 0) print *,'layer soil wetness analysis provided.'
3903 endif
3904 else
3905
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
3906 ! print *,'************************************************'
3907 1 print *,'no soil wetness analysis available. climatology used'
3908 endif
3909 endif
3910 !
3911 ! read in snow depth/snow cover
3912 !
3913 6 irtscv=0
3914
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnsnoa(1:8).ne.' ') then
3915 do i=1,len
3916 scvanl(i)=0.
3917 enddo
3918 !cggg snow mods start
3919 !cggg need to determine if the snow data is on the gaussian grid
3920 !cggg or not. if gaussian, then data is a depth, not liq equiv
3921 !cggg depth. if not gaussian, then data is from hua-lu's
3922 !cggg program and is a liquid equiv. need to communicate
3923 !cggg this to routine fixrda via the 3rd argument which is
3924 !cggg the grib parameter id number.
3925 call baopenr(lugb,fnsnoa,iret)
3926 if (iret .ne. 0) then
3927 write(6,*) ' error in opening file ',trim(fnsnoa)
3928 print *,'error in opening file ',trim(fnsnoa)
3929 call abort
3930 endif
3931 lugi=0
3932 lskip=-1
3933 jpds=-1
3934 jgds=-1
3935 kpds=jpds
3936 call getgbh(lugb,lugi,lskip,jpds,jgds,lgrib,ndata,
3937 & lskip,kpds,kgds,iret)
3938 close(lugb)
3939 if (iret .ne. 0) then
3940 write(6,*) ' error reading header of file: ',trim(fnsnoa)
3941 print *,'error reading header of file: ',trim(fnsnoa)
3942 call abort
3943 endif
3944 if (kgds(1) == 4) then ! gaussian data is depth
3945 call fixrda(lugb,fnsnoa,kpdsnd,slmask,
3946 & iy,im,id,ih,fh,snoanl,len,iret
3947 &, imsk, jmsk, slmskh, gaus,blno, blto
3948 &, outlat, outlon, me)
3949 snoanl=snoanl*100. ! convert from meters to liq. eq.
3950 ! depth in mm using 10:1 ratio
3951 else ! lat/lon data is liq equv. depth
3952 call fixrda(lugb,fnsnoa,kpdsno,slmask,
3953 & iy,im,id,ih,fh,snoanl,len,iret
3954 &, imsk, jmsk, slmskh, gaus,blno, blto
3955 &, outlat, outlon, me)
3956 endif
3957 !cggg snow mods end
3958 irtscv=iret
3959 if(iret.eq.1) then
3960 write(6,*) 'snow depth analysis read error'
3961 call abort
3962 elseif(iret.eq.-1) then
3963 if (me .eq. 0) then
3964 print *,'old snow depth analysis provided, indicating proper',
3965 & ' file name is given. no error suspected.'
3966 write(6,*) 'forecast guess will be used'
3967 endif
3968 else
3969 if (me .eq. 0) print *,'snow depth analysis provided.'
3970 endif
3971 irtsno=0
3972
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 elseif(fnscva(1:8).ne.' ') then
3973 do i=1,len
3974 snoanl(i)=0.
3975 enddo
3976 call fixrda(lugb,fnscva,kpdscv,slmask,
3977 & iy,im,id,ih,fh,scvanl,len,iret
3978 &, imsk, jmsk, slmskh, gaus,blno, blto
3979 &, outlat, outlon, me)
3980 irtsno=iret
3981 if(iret.eq.1) then
3982 write(6,*) 'snow cover analysis read error'
3983 call abort
3984 elseif(iret.eq.-1) then
3985 if (me .eq. 0) then
3986 print *,'old snow cover analysis provided, indicating proper',
3987 & ' file name is given. no error suspected.'
3988 write(6,*) 'forecast guess will be used'
3989 endif
3990 else
3991 if (me .eq. 0) print *,'snow cover analysis provided.'
3992 endif
3993 else
3994
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
3995 ! print *,'************************************************'
3996 1 print *,'no snow/snocov analysis available. climatology used'
3997 endif
3998 endif
3999 !
4000 ! sea ice mask
4001 !
4002 6 irtacn=0
4003 6 irtais=0
4004
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnacna(1:8).ne.' ') then
4005 call fixrda(lugb,fnacna,kpdacn,slmask,
4006 & iy,im,id,ih,fh,acnanl,len,iret
4007 &, imsk, jmsk, slmskh, gaus,blno, blto
4008 &, outlat, outlon, me)
4009 irtacn=iret
4010 if(iret.eq.1) then
4011 write(6,*) 'ice concentration analysis read error'
4012 call abort
4013 elseif(iret.eq.-1) then
4014 if (me .eq. 0) then
4015 print *,'old ice concentration analysis provided',
4016 & ' indicating proper file name is given'
4017 print *,' no error suspected.'
4018 write(6,*) 'forecast guess will be used'
4019 endif
4020 else
4021 if (me .eq. 0) print *,'ice concentration analysis provided.'
4022 endif
4023
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 elseif(fnaisa(1:8).ne.' ') then
4024 call fixrda(lugb,fnaisa,kpdais,slmask,
4025 & iy,im,id,ih,fh,aisanl,len,iret
4026 &, imsk, jmsk, slmskh, gaus,blno, blto
4027 &, outlat, outlon, me)
4028 irtais=iret
4029 if(iret.eq.1) then
4030 write(6,*) 'ice mask analysis read error'
4031 call abort
4032 elseif(iret.eq.-1) then
4033 if (me .eq. 0) then
4034 print *,'old ice-mask analysis provided, indicating proper',
4035 & ' file name is given. no error suspected.'
4036 write(6,*) 'forecast guess will be used'
4037 endif
4038 else
4039 if (me .eq. 0) print *,'ice mask analysis provided.'
4040 endif
4041 else
4042
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
4043 ! print *,'************************************************'
4044 1 print *,'no sea-ice analysis available. climatology used'
4045 endif
4046 endif
4047 !
4048 ! surface roughness
4049 !
4050 6 irtzor=0
4051
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnzora(1:8).ne.' ') then
4052 call fixrda(lugb,fnzora,kpdzor,slmask,
4053 & iy,im,id,ih,fh,zoranl,len,iret
4054 &, imsk, jmsk, slmskh, gaus,blno, blto
4055 &, outlat, outlon, me)
4056 irtzor=iret
4057 if(iret.eq.1) then
4058 write(6,*) 'roughness analysis read error'
4059 call abort
4060 elseif(iret.eq.-1) then
4061 if (me .eq. 0) then
4062 print *,'old roughness analysis provided, indicating proper',
4063 & ' file name is given. no error suspected.'
4064 write(6,*) 'forecast guess will be used'
4065 endif
4066 else
4067 if (me .eq. 0) print *,'roughness analysis provided.'
4068 endif
4069 else
4070
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
4071 ! print *,'************************************************'
4072 1 print *,'no srfc roughness analysis available. climatology used'
4073 endif
4074 endif
4075 !
4076 ! deep soil temperature
4077 !
4078 6 irttg3=0
4079 6 irtstc=0
4080
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fntg3a(1:8).ne.' ') then
4081 call fixrda(lugb,fntg3a,kpdtg3,slmask,
4082 & iy,im,id,ih,fh,tg3anl,len,iret
4083 &, imsk, jmsk, slmskh, gaus,blno, blto
4084 &, outlat, outlon, me)
4085 irttg3=iret
4086 if(iret.eq.1) then
4087 write(6,*) 'deep soil tmp analysis read error'
4088 call abort
4089 elseif(iret.eq.-1) then
4090 if (me .eq. 0) then
4091 print *,'old deep soil temp analysis provided',
4092 & ' indicating proper file name is given.'
4093 print *,' no error suspected.'
4094 write(6,*) 'forecast guess will be used'
4095 endif
4096 else
4097 if (me .eq. 0) print *,'deep soil tmp analysis provided.'
4098 endif
4099
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 elseif(fnstca(1:8).ne.' ') then
4100 call fixrda(lugb,fnstca,kpdstc,slmask,
4101 & iy,im,id,ih,fh,stcanl(1,1),len,iret
4102 &, imsk, jmsk, slmskh, gaus,blno, blto
4103 &, outlat, outlon, me)
4104 call fixrda(lugb,fnstca,kpdstc,slmask,
4105 & iy,im,id,ih,fh,stcanl(1,2),len,iret
4106 &, imsk, jmsk, slmskh, gaus,blno, blto
4107 &, outlat, outlon, me)
4108 irtstc=iret
4109 if(iret.eq.1) then
4110 write(6,*) 'layer soil tmp analysis read error'
4111 call abort
4112 elseif(iret.eq.-1) then
4113 if (me .eq. 0) then
4114 print *,'old deep soil temp analysis provided',
4115 & 'iindicating proper file name is given.'
4116 print *,' no error suspected.'
4117 write(6,*) 'forecast guess will be used'
4118 endif
4119 else
4120 if (me .eq. 0) print *,'layer soil tmp analysis provided.'
4121 endif
4122 else
4123
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
4124 ! print *,'************************************************'
4125 1 print *,'no deep soil temp analy available. climatology used'
4126 endif
4127 endif
4128 !
4129 ! vegetation cover
4130 !
4131 6 irtveg=0
4132
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnvega(1:8).ne.' ') then
4133 call fixrda(lugb,fnvega,kpdveg,slmask,
4134 & iy,im,id,ih,fh,veganl,len,iret
4135 &, imsk, jmsk, slmskh, gaus,blno, blto
4136 &, outlat, outlon, me)
4137 irtveg=iret
4138 if(iret.eq.1) then
4139 write(6,*) 'vegetation cover analysis read error'
4140 call abort
4141 elseif(iret.eq.-1) then
4142 if (me .eq. 0) then
4143 print *,'old vegetation cover analysis provided',
4144 & ' indicating proper file name is given.'
4145 print *,' no error suspected.'
4146 write(6,*) 'forecast guess will be used'
4147 endif
4148 else
4149 if (me .eq. 0) print *,'gegetation cover analysis provided.'
4150 endif
4151 else
4152
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
4153 ! print *,'************************************************'
4154 1 print *,'no vegetation cover anly available. climatology used'
4155 endif
4156 endif
4157 !
4158 ! vegetation type
4159 !
4160 6 irtvet=0
4161
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnveta(1:8).ne.' ') then
4162 call fixrda(lugb,fnveta,kpdvet,slmask,
4163 & iy,im,id,ih,fh,vetanl,len,iret
4164 &, imsk, jmsk, slmskh, gaus,blno, blto
4165 &, outlat, outlon, me)
4166 irtvet=iret
4167 if(iret.eq.1) then
4168 write(6,*) 'vegetation type analysis read error'
4169 call abort
4170 elseif(iret.eq.-1) then
4171 if (me .eq. 0) then
4172 print *,'old vegetation type analysis provided',
4173 & ' indicating proper file name is given.'
4174 print *,' no error suspected.'
4175 write(6,*) 'forecast guess will be used'
4176 endif
4177 else
4178 if (me .eq. 0) print *,'vegetation type analysis provided.'
4179 endif
4180 else
4181
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
4182 ! print *,'************************************************'
4183 1 print *,'no vegetation type anly available. climatology used'
4184 endif
4185 endif
4186 !
4187 ! soil type
4188 !
4189 6 irtsot=0
4190
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnsota(1:8).ne.' ') then
4191 call fixrda(lugb,fnsota,kpdsot,slmask,
4192 & iy,im,id,ih,fh,sotanl,len,iret
4193 &, imsk, jmsk, slmskh, gaus,blno, blto
4194 &, outlat, outlon, me)
4195 irtsot=iret
4196 if(iret.eq.1) then
4197 write(6,*) 'soil type analysis read error'
4198 call abort
4199 elseif(iret.eq.-1) then
4200 if (me .eq. 0) then
4201 print *,'old soil type analysis provided',
4202 & ' indicating proper file name is given.'
4203 print *,' no error suspected.'
4204 write(6,*) 'forecast guess will be used'
4205 endif
4206 else
4207 if (me .eq. 0) print *,'soil type analysis provided.'
4208 endif
4209 else
4210
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
4211 ! print *,'************************************************'
4212 1 print *,'no soil type anly available. climatology used'
4213 endif
4214 endif
4215
4216 !clu [+120l]--------------------------------------------------------------
4217 !
4218 ! min vegetation cover
4219 !
4220 6 irtvmn=0
4221
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnvmna(1:8).ne.' ') then
4222 call fixrda(lugb,fnvmna,kpdvmn,slmask,
4223 & iy,im,id,ih,fh,vmnanl,len,iret
4224 &, imsk, jmsk, slmskh, gaus,blno, blto
4225 &, outlat, outlon, me)
4226 irtvmn=iret
4227 if(iret.eq.1) then
4228 write(6,*) 'shdmin analysis read error'
4229 call abort
4230 elseif(iret.eq.-1) then
4231 if (me .eq. 0) then
4232 print *,'old shdmin analysis provided',
4233 & ' indicating proper file name is given.'
4234 print *,' no error suspected.'
4235 write(6,*) 'forecast guess will be used'
4236 endif
4237 else
4238 if (me .eq. 0) print *,'shdmin analysis provided.'
4239 endif
4240 else
4241
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
4242 ! print *,'************************************************'
4243 1 print *,'no shdmin anly available. climatology used'
4244 endif
4245 endif
4246
4247 !
4248 ! max vegetation cover
4249 !
4250 6 irtvmx=0
4251
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnvmxa(1:8).ne.' ') then
4252 call fixrda(lugb,fnvmxa,kpdvmx,slmask,
4253 & iy,im,id,ih,fh,vmxanl,len,iret
4254 &, imsk, jmsk, slmskh, gaus,blno, blto
4255 &, outlat, outlon, me)
4256 irtvmx=iret
4257 if(iret.eq.1) then
4258 write(6,*) 'shdmax analysis read error'
4259 call abort
4260 elseif(iret.eq.-1) then
4261 if (me .eq. 0) then
4262 print *,'old shdmax analysis provided',
4263 & ' indicating proper file name is given.'
4264 print *,' no error suspected.'
4265 write(6,*) 'forecast guess will be used'
4266 endif
4267 else
4268 if (me .eq. 0) print *,'shdmax analysis provided.'
4269 endif
4270 else
4271
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
4272 ! print *,'************************************************'
4273 1 print *,'no shdmax anly available. climatology used'
4274 endif
4275 endif
4276
4277 !
4278 ! slope type
4279 !
4280 6 irtslp=0
4281
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnslpa(1:8).ne.' ') then
4282 call fixrda(lugb,fnslpa,kpdslp,slmask,
4283 & iy,im,id,ih,fh,slpanl,len,iret
4284 &, imsk, jmsk, slmskh, gaus,blno, blto
4285 &, outlat, outlon, me)
4286 irtslp=iret
4287 if(iret.eq.1) then
4288 write(6,*) 'slope type analysis read error'
4289 call abort
4290 elseif(iret.eq.-1) then
4291 if (me .eq. 0) then
4292 print *,'old slope type analysis provided',
4293 & ' indicating proper file name is given.'
4294 print *,' no error suspected.'
4295 write(6,*) 'forecast guess will be used'
4296 endif
4297 else
4298 if (me .eq. 0) print *,'slope type analysis provided.'
4299 endif
4300 else
4301
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
4302 ! print *,'************************************************'
4303 1 print *,'no slope type anly available. climatology used'
4304 endif
4305 endif
4306
4307 !
4308 ! max snow albedo
4309 !
4310 6 irtabs=0
4311
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnabsa(1:8).ne.' ') then
4312 call fixrda(lugb,fnabsa,kpdabs,slmask,
4313 & iy,im,id,ih,fh,absanl,len,iret
4314 &, imsk, jmsk, slmskh, gaus,blno, blto
4315 &, outlat, outlon, me)
4316 irtabs=iret
4317 if(iret.eq.1) then
4318 write(6,*) 'snoalb analysis read error'
4319 call abort
4320 elseif(iret.eq.-1) then
4321 if (me .eq. 0) then
4322 print *,'old snoalb analysis provided',
4323 & ' indicating proper file name is given.'
4324 print *,' no error suspected.'
4325 write(6,*) 'forecast guess will be used'
4326 endif
4327 else
4328 if (me .eq. 0) print *,'snoalb analysis provided.'
4329 endif
4330 else
4331
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
4332 ! print *,'************************************************'
4333 1 print *,'no snoalb anly available. climatology used'
4334 endif
4335 endif
4336
4337 !clu ----------------------------------------------------------------------
4338 !
4339 6 return
4340 end
4341 subroutine filfcs(tsffcs,wetfcs,snofcs,zorfcs,albfcs,
4342 & tg3fcs,cvfcs ,cvbfcs,cvtfcs,
4343 & cnpfcs,smcfcs,stcfcs,slifcs,aisfcs,
4344 & vegfcs, vetfcs, sotfcs, alffcs,
4345 !cwu [+1l] add ()fcs for sih, sic
4346 & sihfcs,sicfcs,
4347 !clu [+1l] add ()fcs for vmn, vmx, slp, abs
4348 & vmnfcs,vmxfcs,slpfcs,absfcs,
4349 & tsfanl,wetanl,snoanl,zoranl,albanl,
4350 & tg3anl,cvanl ,cvbanl,cvtanl,
4351 & cnpanl,smcanl,stcanl,slianl,aisanl,
4352 & veganl, vetanl, sotanl, alfanl,
4353 !cwu [+1l] add ()anl for sih, sic
4354 & sihanl,sicanl,
4355 !clu [+1l] add ()anl for vmn, vmx, slp, abs
4356 & vmnanl,vmxanl,slpanl,absanl,
4357 & len,lsoil)
4358 !
4359 use machine , only : kind_io8,kind_io4
4360 implicit none
4361 integer i,j,len,lsoil
4362 real (kind=kind_io8) tsffcs(len),wetfcs(len),snofcs(len),
4363 & zorfcs(len),albfcs(len,4),aisfcs(len),
4364 & tg3fcs(len),
4365 & cvfcs (len),cvbfcs(len),cvtfcs(len),
4366 & cnpfcs(len),
4367 & smcfcs(len,lsoil),stcfcs(len,lsoil),
4368 & slifcs(len),vegfcs(len),
4369 & vetfcs(len),sotfcs(len),alffcs(len,2)
4370 !cwu [+1l] add ()fcs for sih, sic
4371 &, sihfcs(len),sicfcs(len)
4372 !clu [+1l] add ()fcs for vmn, vmx, slp, abs
4373 &, vmnfcs(len),vmxfcs(len),slpfcs(len),absfcs(len)
4374 real (kind=kind_io8) tsfanl(len),wetanl(len),snoanl(len),
4375 & zoranl(len),albanl(len,4),aisanl(len),
4376 & tg3anl(len),
4377 & cvanl (len),cvbanl(len),cvtanl(len),
4378 & cnpanl(len),
4379 & smcanl(len,lsoil),stcanl(len,lsoil),
4380 & slianl(len),veganl(len),
4381 & vetanl(len),sotanl(len),alfanl(len,2)
4382 !cwu [+1l] add ()anl for sih, sic
4383 &, sihanl(len),sicanl(len)
4384 !clu [+1l] add ()anl for vmn, vmx, slp, abs
4385 &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len)
4386 !
4387 write(6,*) ' this is a dead start run, tsfc over land is',
4388 & ' set as lowest sigma level temperture if given.'
4389 write(6,*) ' if not, set to climatological tsf over land is used'
4390 !
4391 !
4392 do i=1,len
4393 tsffcs(i) = tsfanl(i) ! tsf
4394 albfcs(i,1) = albanl(i,1) ! albedo
4395 albfcs(i,2) = albanl(i,2) ! albedo
4396 albfcs(i,3) = albanl(i,3) ! albedo
4397 albfcs(i,4) = albanl(i,4) ! albedo
4398 wetfcs(i) = wetanl(i) ! soil wetness
4399 snofcs(i) = snoanl(i) ! snow
4400 aisfcs(i) = aisanl(i) ! seaice
4401 slifcs(i) = slianl(i) ! land/sea/snow mask
4402 zorfcs(i) = zoranl(i) ! surface roughness
4403 ! plrfcs(i) = plranl(i) ! maximum stomatal resistance
4404 tg3fcs(i) = tg3anl(i) ! deep soil temperature
4405 cnpfcs(i) = cnpanl(i) ! canopy water content
4406 cvfcs(i) = cvanl(i) ! cv
4407 cvbfcs(i) = cvbanl(i) ! cvb
4408 cvtfcs(i) = cvtanl(i) ! cvt
4409 vegfcs(i) = veganl(i) ! vegetation cover
4410 vetfcs(i) = vetanl(i) ! vegetation type
4411 sotfcs(i) = sotanl(i) ! soil type
4412 alffcs(i,1) = alfanl(i,1) ! vegetation fraction for albedo
4413 alffcs(i,2) = alfanl(i,2) ! vegetation fraction for albedo
4414 !cwu [+2l] add sih, sic
4415 sihfcs(i) = sihanl(i) ! sea ice thickness
4416 sicfcs(i) = sicanl(i) ! sea ice concentration
4417 !clu [+4l] add vmn, vmx, slp, abs
4418 vmnfcs(i) = vmnanl(i) ! min vegetation cover
4419 vmxfcs(i) = vmxanl(i) ! max vegetation cover
4420 slpfcs(i) = slpanl(i) ! slope type
4421 absfcs(i) = absanl(i) ! max snow albedo
4422 enddo
4423 !
4424 do j=1,lsoil
4425 do i=1,len
4426 smcfcs(i,j) = smcanl(i,j) ! layer soil wetness
4427 stcfcs(i,j) = stcanl(i,j) ! soil temperature
4428 enddo
4429 enddo
4430 !
4431 return
4432 end
4433 subroutine bktges(smcfcs,slianl,stcfcs,len,lsoil)
4434 !
4435 use machine , only : kind_io8,kind_io4
4436 implicit none
4437 integer i,j,len,lsoil,k
4438 real (kind=kind_io8) smcfcs(len,lsoil), stcfcs(len,lsoil),
4439 & slianl(len)
4440 !
4441 ! note that smfcs comes in with the original unit (cm?) (not grib file)
4442 !
4443 do i = 1, len
4444 smcfcs(i,1) = (smcfcs(i,1)/150.) * .37 + .1
4445 enddo
4446 do k = 2, lsoil
4447 do i = 1, len
4448 smcfcs(i,k) = smcfcs(i,1)
4449 enddo
4450 enddo
4451 if(lsoil.gt.2) then
4452 do k = 3, lsoil
4453 do i = 1, len
4454 stcfcs(i,k) = stcfcs(i,2)
4455 enddo
4456 enddo
4457 endif
4458 !
4459 return
4460 end
4461
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 78 times.
78 subroutine rof01(aisfld,len,op,crit)
4462 use machine , only : kind_io8,kind_io4
4463 implicit none
4464 78 integer i,len
4465 real (kind=kind_io8) aisfld(len),crit
4466 character*2 op
4467 !
4468
2/2
✓ Branch 0 taken 48 times.
✓ Branch 1 taken 30 times.
78 if(op.eq.'ge') then
4469
2/2
✓ Branch 0 taken 112248576 times.
✓ Branch 1 taken 48 times.
112248624 do i=1,len
4470
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 112248576 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 112248576 times.
✓ Branch 6 taken 38027783 times.
✓ Branch 7 taken 74220793 times.
112248624 if(aisfld(i).ge.crit) then
4471
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 38027783 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 38027783 times.
38027783 aisfld(i)=1.
4472 else
4473
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 74220793 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 74220793 times.
74220793 aisfld(i)=0.
4474 endif
4475 enddo
4476
1/2
✓ Branch 0 taken 30 times.
✗ Branch 1 not taken.
30 elseif(op.eq.'gt') then
4477
2/2
✓ Branch 0 taken 40999200 times.
✓ Branch 1 taken 30 times.
40999230 do i=1,len
4478
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 40999200 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 40999200 times.
✓ Branch 6 taken 13752582 times.
✓ Branch 7 taken 27246618 times.
40999230 if(aisfld(i).gt.crit) then
4479
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13752582 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13752582 times.
13752582 aisfld(i)=1.
4480 else
4481
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 27246618 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27246618 times.
27246618 aisfld(i)=0.
4482 endif
4483 enddo
4484 elseif(op.eq.'le') then
4485 do i=1,len
4486 if(aisfld(i).le.crit) then
4487 aisfld(i)=1.
4488 else
4489 aisfld(i)=0.
4490 endif
4491 enddo
4492 elseif(op.eq.'lt') then
4493 do i=1,len
4494 if(aisfld(i).lt.crit) then
4495 aisfld(i)=1.
4496 else
4497 aisfld(i)=0.
4498 endif
4499 enddo
4500 else
4501 write(6,*) ' illegal operator in rof01. op=',op
4502 call abort
4503 endif
4504 !
4505 78 return
4506 end
4507 24 subroutine tsfcor(tsfc,orog,slmask,umask,len,rlapse)
4508 !
4509 use machine , only : kind_io8,kind_io4
4510 implicit none
4511 24 integer i,len
4512 real (kind=kind_io8) rlapse,umask
4513 real (kind=kind_io8) tsfc(len), orog(len), slmask(len)
4514 !
4515
2/2
✓ Branch 0 taken 55296 times.
✓ Branch 1 taken 24 times.
55320 do i=1,len
4516
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✓ Branch 6 taken 27648 times.
✓ Branch 7 taken 27648 times.
55320 if(slmask(i).eq.umask) then
4517
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 27648 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 27648 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 27648 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 27648 times.
27648 tsfc(i) = tsfc(i) - orog(i)*rlapse
4518 endif
4519 enddo
4520 24 return
4521 end
4522 12 subroutine snodpth(scvanl,slianl,tsfanl,snoclm,
4523 12 & glacir,snwmax,snwmin,landice,len,snoanl, me)
4524 use machine , only : kind_io8,kind_io4
4525 implicit none
4526 6 integer i,me,len
4527 logical, intent(in) :: landice
4528 6 real (kind=kind_io8) sno,snwmax,snwmin
4529 !
4530 real (kind=kind_io8) scvanl(len), slianl(len), tsfanl(len),
4531 & snoclm(len), snoanl(len), glacir(len)
4532 !
4533
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) write(6,*) 'snodpth'
4534 !
4535 ! use surface temperature to get snow depth estimate
4536 !
4537
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
4538 13824 sno = 0.0
4539 !
4540 ! over land
4541 !
4542
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 4015 times.
✓ Branch 7 taken 9809 times.
13824 if(slianl(i).eq.1.) then
4543
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 4015 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4015 times.
✓ Branch 6 taken 377 times.
✓ Branch 7 taken 3638 times.
4015 if(scvanl(i).eq.1.0) then
4544
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 377 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 377 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 377 times.
377 if(tsfanl(i).lt.243.0) then
4545 sno = snwmax
4546
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 377 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 377 times.
✓ Branch 6 taken 276 times.
✓ Branch 7 taken 101 times.
377 elseif(tsfanl(i).lt.273.0) then
4547
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 276 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 276 times.
276 sno = snwmin+(snwmax-snwmin)*(273.0-tsfanl(i))/30.0
4548 else
4549 101 sno = snwmin
4550 endif
4551 endif
4552 !
4553 ! if glacial points has snow in climatology, set sno to snomax
4554 !
4555
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 4015 times.
4015 if (.not.landice) then
4556 if(glacir(i).eq.1.0) then
4557 sno = snoclm(i)
4558 if(sno.eq.0.) sno=snwmax
4559 endif
4560 endif
4561 endif
4562 !
4563 ! over sea ice
4564 !
4565 ! snow over sea ice is cycled as of 01/01/94.....hua-lu pan
4566 !
4567
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 624 times.
✓ Branch 7 taken 13200 times.
13824 if(slianl(i).eq.2.0) then
4568
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 624 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 624 times.
624 sno=snoclm(i)
4569
2/2
✓ Branch 0 taken 621 times.
✓ Branch 1 taken 3 times.
624 if(sno.eq.0.) sno=snwmax
4570 endif
4571 !
4572
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13830 snoanl(i) = sno
4573 enddo
4574 6 return
4575 end subroutine snodpth
4576 6 subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc,
4577 12 & sihfcs,sicfcs,
4578 24 & vmnfcs,vmxfcs,slpfcs,absfcs,
4579 30 & tsffcs,wetfcs,snofcs,zorfcs,albfcs,aisfcs,
4580 18 & cvfcs ,cvbfcs,cvtfcs,
4581 30 & cnpfcs,smcfcs,stcfcs,slifcs,vegfcs,
4582 18 & vetfcs,sotfcs,alffcs,
4583 12 & sihanl,sicanl,
4584 24 & vmnanl,vmxanl,slpanl,absanl,
4585 30 & tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl,aisanl,
4586 18 & cvanl ,cvbanl,cvtanl,
4587 30 & cnpanl,smcanl,stcanl,slianl,veganl,
4588 18 & vetanl,sotanl,alfanl,
4589 12 & ctsfl,calbl,caisl,csnol,csmcl,czorl,cstcl,cvegl,
4590 12 & ctsfs,calbs,caiss,csnos,csmcs,czors,cstcs,cvegs,
4591 & ccv,ccvb,ccvt,ccnp,cvetl,cvets,csotl,csots,
4592 & calfl,calfs,
4593 & csihl,csihs,csicl,csics,
4594 & cvmnl,cvmns,cvmxl,cvmxs,cslpl,cslps,cabsl,cabss,
4595 & irttsf,irtwet,irtsno,irtzor,irtalb,irtais,
4596 & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg,
4597 & irtvmn,irtvmx,irtslp,irtabs,
4598 & irtvet,irtsot,irtalf, landice, me)
4599 use machine , only : kind_io8,kind_io4
4600 use sfccyc_module, only : veg_type_landice, soil_type_landice
4601 implicit none
4602 12 integer k,i,im,id,iy,len,lsoil,ih,irtacn,irtsmc,irtscv,irtais,
4603 & irttg3,irtstc,irtalf,me,irtsot,irtveg,irtvet, irtzor,
4604 & irtalb,irtsno,irttsf,irtwet,j
4605 &, irtvmn,irtvmx,irtslp,irtabs
4606 logical, intent(in) :: landice
4607 42 real (kind=kind_io8) rvegs,rvets,rzors,raiss,rsnos,rsots,rcnp,
4608 30 & rcvt,rcv,rcvb,rsnol,rzorl,raisl,ralbl,
4609 24 & ralfl,rvegl,ralbs,ralfs,rtsfs,rvetl,rsotl,
4610 42 & qzors,qvegs,qsnos,qalfs,qaiss,qvets,qcvt,
4611 30 & qcnp,qcvb,qsots,qcv,qaisl,qsnol,qalfl,
4612 24 & qtsfl,qalbl,qzorl,qtsfs,qalbs,qsotl,qvegl,
4613 12 & qvetl,rtsfl,calbs,caiss,ctsfs,czorl,cvegl,
4614 & csnos,ccvb,ccvt,ccv,czors,cvegs,caisl,csnol,
4615 & calbl,fh,ctsfl,ccnp,csots,calfl,csotl,cvetl,
4616 & cvets,calfs,deltsfc,
4617 & csihl,csihs,csicl,csics,
4618 6 & rsihl,rsihs,rsicl,rsics,
4619 6 & qsihl,qsihs,qsicl,qsics
4620 &, cvmnl,cvmns,cvmxl,cvmxs,cslpl,cslps
4621 6 &, cabsl,cabss,rvmnl,rvmns,rvmxl,rvmxs
4622 18 &, rslpl,rslps,rabsl,rabss,qvmnl,qvmns
4623 18 &, qvmxl,qvmxs,qslpl,qslps,qabsl,qabss
4624 !
4625 real (kind=kind_io8) tsffcs(len), wetfcs(len), snofcs(len),
4626 & zorfcs(len), albfcs(len,4), aisfcs(len),
4627 & cvfcs (len), cvbfcs(len), cvtfcs(len),
4628 & cnpfcs(len),
4629 & smcfcs(len,lsoil),stcfcs(len,lsoil),
4630 & slifcs(len), vegfcs(len),
4631 & vetfcs(len), sotfcs(len), alffcs(len,2)
4632 &, sihfcs(len), sicfcs(len)
4633 &, vmnfcs(len),vmxfcs(len),slpfcs(len),absfcs(len)
4634 real (kind=kind_io8) tsfanl(len),tsfan2(len),
4635 & wetanl(len),snoanl(len),
4636 & zoranl(len), albanl(len,4), aisanl(len),
4637 & cvanl (len), cvbanl(len), cvtanl(len),
4638 & cnpanl(len),
4639 & smcanl(len,lsoil),stcanl(len,lsoil),
4640 & slianl(len), veganl(len),
4641 & vetanl(len), sotanl(len), alfanl(len,2)
4642 &, sihanl(len),sicanl(len)
4643 &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len)
4644 !
4645 real (kind=kind_io8) csmcl(lsoil), csmcs(lsoil),
4646 & cstcl(lsoil), cstcs(lsoil)
4647
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 24 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 24 times.
✓ Branch 21 taken 6 times.
18 real (kind=kind_io8) rsmcl(lsoil), rsmcs(lsoil),
4648
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 24 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 24 times.
✓ Branch 21 taken 6 times.
18 & rstcl(lsoil), rstcs(lsoil)
4649
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 24 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 24 times.
✓ Branch 21 taken 6 times.
18 real (kind=kind_io8) qsmcl(lsoil), qsmcs(lsoil),
4650
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 24 times.
✓ Branch 10 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 6 times.
✓ Branch 20 taken 24 times.
✓ Branch 21 taken 6 times.
18 & qstcl(lsoil), qstcs(lsoil)
4651 logical first
4652 integer num_threads
4653 data first /.true./
4654 save num_threads, first
4655 !
4656 12 integer len_thread_m, i1_t, i2_t, it
4657 integer num_parthds
4658 !
4659
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (first) then
4660 6 num_threads = num_parthds()
4661 6 first = .false.
4662 endif
4663 !
4664 ! coeeficients of blending forecast and interpolated clim
4665 ! (or analyzed) fields over sea or land(l) (not for clouds)
4666 ! 1.0 = use of forecast
4667 ! 0.0 = replace with interpolated analysis
4668 !
4669 ! merging coefficients are defined by parameter statement in calling program
4670 ! and therefore they should not be modified in this program.
4671 !
4672 6 rtsfl = ctsfl
4673 6 ralbl = calbl
4674 6 ralfl = calfl
4675 6 raisl = caisl
4676 6 rsnol = csnol
4677 !clu rsmcl = csmcl
4678 6 rzorl = czorl
4679 6 rvegl = cvegl
4680 6 rvetl = cvetl
4681 6 rsotl = csotl
4682 6 rsihl = csihl
4683 6 rsicl = csicl
4684 6 rvmnl = cvmnl
4685 6 rvmxl = cvmxl
4686 6 rslpl = cslpl
4687 6 rabsl = cabsl
4688 !
4689 6 rtsfs = ctsfs
4690 6 ralbs = calbs
4691 6 ralfs = calfs
4692 6 raiss = caiss
4693 6 rsnos = csnos
4694 ! rsmcs = csmcs
4695 6 rzors = czors
4696 6 rvegs = cvegs
4697 6 rvets = cvets
4698 6 rsots = csots
4699 6 rsihs = csihs
4700 6 rsics = csics
4701 6 rvmns = cvmns
4702 6 rvmxs = cvmxs
4703 6 rslps = cslps
4704 6 rabss = cabss
4705 !
4706 6 rcv = ccv
4707 6 rcvb = ccvb
4708 6 rcvt = ccvt
4709 6 rcnp = ccnp
4710 !
4711
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do k=1,lsoil
4712
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 24 times.
24 rsmcl(k) = csmcl(k)
4713
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 24 times.
24 rsmcs(k) = csmcs(k)
4714
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 24 times.
24 rstcl(k) = cstcl(k)
4715
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 24 times.
30 rstcs(k) = cstcs(k)
4716 enddo
4717
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 6 times.
✗ Branch 3 not taken.
6 if (fh-deltsfc < -0.001 .and. irttsf == 1) then
4718 6 rtsfs = 1.0
4719 6 rtsfl = 1.0
4720 ! do k=1,lsoil
4721 ! rsmcl(k) = 1.0
4722 ! rsmcs(k) = 1.0
4723 ! rstcl(k) = 1.0
4724 ! rstcs(k) = 1.0
4725 ! enddo
4726 endif
4727 !
4728 ! if analysis file name is given but no matching analysis date found,
4729 ! use guess (these are flagged by irt???=1).
4730 !
4731
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(irttsf == -1) then
4732 rtsfl = 1.
4733 rtsfs = 1.
4734 endif
4735
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(irtalb == -1) then
4736 ralbl = 1.
4737 ralbs = 1.
4738 ralfl = 1.
4739 ralfs = 1.
4740 endif
4741
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(irtais == -1) then
4742 raisl = 1.
4743 raiss = 1.
4744 endif
4745
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if(irtsno == -1 .or. irtscv == -1) then
4746 rsnol = 1.
4747 rsnos = 1.
4748 endif
4749
2/4
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
6 if(irtsmc == -1 .or. irtwet == -1) then
4750 ! rsmcl = 1.
4751 ! rsmcs = 1.
4752 do k=1,lsoil
4753 rsmcl(k) = 1.
4754
0/4
✗ Branch 0 not taken.
✗ Branch 1 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
6 rsmcs(k) = 1.
4755 enddo
4756 endif
4757
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(irtstc.eq.-1) then
4758 do k=1,lsoil
4759 rstcl(k) = 1.
4760 rstcs(k) = 1.
4761 enddo
4762 endif
4763
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(irtzor == -1) then
4764 rzorl = 1.
4765 rzors = 1.
4766 endif
4767
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(irtveg == -1) then
4768 rvegl = 1.
4769 rvegs = 1.
4770 endif
4771
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(irtvet.eq.-1) then
4772 rvetl = 1.
4773 rvets = 1.
4774 endif
4775
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(irtsot == -1) then
4776 rsotl = 1.
4777 rsots = 1.
4778 endif
4779
4780
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(irtacn == -1) then
4781 rsicl = 1.
4782 rsics = 1.
4783 endif
4784
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(irtvmn == -1) then
4785 rvmnl = 1.
4786 rvmns = 1.
4787 endif
4788
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(irtvmx == -1) then
4789 rvmxl = 1.
4790 rvmxs = 1.
4791 endif
4792
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(irtslp == -1) then
4793 rslpl = 1.
4794 rslps = 1.
4795 endif
4796
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(irtabs == -1) then
4797 rabsl = 1.
4798 rabss = 1.
4799 endif
4800 !
4801
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
6 if(raiss == 1. .or. irtacn == -1) then
4802
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me == 0) print *,'use forecast land-sea-ice mask'
4803
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 13824 times.
13830 do i = 1, len
4804
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 aisanl(i) = aisfcs(i)
4805
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 slianl(i) = slifcs(i)
4806 enddo
4807 endif
4808 !
4809
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me == 0) then
4810
3/6
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 1 times.
1 write(6,100) rtsfl,ralbl,raisl,rsnol,rsmcl,rzorl,rvegl
4811 100 format('rtsfl,ralbl,raisl,rsnol,rsmcl,rzorl,rvegl=',10f7.3)
4812
3/6
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 1 times.
1 write(6,101) rtsfs,ralbs,raiss,rsnos,rsmcs,rzors,rvegs
4813 101 format('rtsfs,ralbs,raiss,rsnos,rsmcs,rzors,rvegs=',10f7.3)
4814 ! print *,' ralfl=',ralfl,' ralfs=',ralfs,' rsotl=',rsotl
4815 ! *,' rsots=',rsots,' rvetl=',rvetl,' rvets=',rvets
4816 endif
4817 !
4818 6 qtsfl = 1. - rtsfl
4819 6 qalbl = 1. - ralbl
4820 6 qalfl = 1. - ralfl
4821 6 qaisl = 1. - raisl
4822 6 qsnol = 1. - rsnol
4823 ! qsmcl = 1. - rsmcl
4824 6 qzorl = 1. - rzorl
4825 6 qvegl = 1. - rvegl
4826 6 qvetl = 1. - rvetl
4827 6 qsotl = 1. - rsotl
4828 6 qsihl = 1. - rsihl
4829 6 qsicl = 1. - rsicl
4830 6 qvmnl = 1. - rvmnl
4831 6 qvmxl = 1. - rvmxl
4832 6 qslpl = 1. - rslpl
4833 6 qabsl = 1. - rabsl
4834 !
4835 6 qtsfs = 1. - rtsfs
4836 6 qalbs = 1. - ralbs
4837 6 qalfs = 1. - ralfs
4838 6 qaiss = 1. - raiss
4839 6 qsnos = 1. - rsnos
4840 ! qsmcs = 1. - rsmcs
4841 6 qzors = 1. - rzors
4842 6 qvegs = 1. - rvegs
4843 6 qvets = 1. - rvets
4844 6 qsots = 1. - rsots
4845 6 qsihs = 1. - rsihs
4846 6 qsics = 1. - rsics
4847 6 qvmns = 1. - rvmns
4848 6 qvmxs = 1. - rvmxs
4849 6 qslps = 1. - rslps
4850 6 qabss = 1. - rabss
4851 !
4852 6 qcv = 1. - rcv
4853 6 qcvb = 1. - rcvb
4854 6 qcvt = 1. - rcvt
4855 6 qcnp = 1. - rcnp
4856 !
4857
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do k=1,lsoil
4858
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 24 times.
24 qsmcl(k) = 1. - rsmcl(k)
4859
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 24 times.
24 qsmcs(k) = 1. - rsmcs(k)
4860
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 24 times.
24 qstcl(k) = 1. - rstcl(k)
4861
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 24 times.
30 qstcs(k) = 1. - rstcs(k)
4862 enddo
4863 !
4864 ! merging
4865 !
4866
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if(me .eq. 0) then
4867
5/8
✓ Branch 2 taken 5 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4 times.
✓ Branch 5 taken 1 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4 times.
1 print *, 'dbgx-- csmcl:', (csmcl(k),k=1,lsoil)
4868
5/8
✓ Branch 2 taken 5 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4 times.
✓ Branch 5 taken 1 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4 times.
1 print *, 'dbgx-- rsmcl:', (rsmcl(k),k=1,lsoil)
4869 1 print *, 'dbgx-- csnol, csnos:',csnol,csnos
4870 1 print *, 'dbgx-- rsnol, rsnos:',rsnol,rsnos
4871 endif
4872
4873 ! print *, rtsfs, qtsfs, raiss , qaiss
4874 ! *, rsnos , qsnos, rzors , qzors, rvegs , qvegs
4875 ! *, rvets , qvets, rsots , qsots
4876 ! *, rcv, rcvb, rcvt, qcv, qcvb, qcvt
4877 ! *, ralbs, qalbs, ralfs, qalfs
4878 ! print *, rtsfl, qtsfl, raisl , qaisl
4879 ! *, rsnol , qsnol, rzorl , qzorl, rvegl , qvegl
4880 ! *, rvetl , qvetl, rsotl , qsotl
4881 ! *, ralbl, qalbl, ralfl, qalfl
4882 !
4883 !
4884 6 len_thread_m = (len+num_threads-1) / num_threads
4885
4886 !$omp parallel do private(i1_t,i2_t,it,i)
4887
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
12 do it=1,num_threads ! start of threaded loop ...................
4888 6 i1_t = (it-1)*len_thread_m+1
4889
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 i2_t = min(i1_t+len_thread_m-1,len)
4890
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13836 do i=i1_t,i2_t
4891
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 9309 times.
✓ Branch 7 taken 4515 times.
13830 if(slianl(i).eq.0.) then
4892
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 9309 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9309 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9309 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9309 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 9309 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 9309 times.
9309 vetanl(i) = vetfcs(i)*rvets + vetanl(i)*qvets
4893
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 9309 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9309 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9309 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9309 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 9309 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 9309 times.
9309 sotanl(i) = sotfcs(i)*rsots + sotanl(i)*qsots
4894 else
4895
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 4515 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4515 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4515 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4515 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4515 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4515 times.
4515 vetanl(i) = vetfcs(i)*rvetl + vetanl(i)*qvetl
4896
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 4515 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4515 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4515 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4515 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4515 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4515 times.
4515 sotanl(i) = sotfcs(i)*rsotl + sotanl(i)*qsotl
4897 endif
4898 enddo
4899 enddo
4900 !$omp end parallel do
4901 !
4902 !$omp parallel do private(i1_t,i2_t,it,i,k)
4903 !
4904
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
12 do it=1,num_threads ! start of threaded loop ...................
4905 6 i1_t = (it-1)*len_thread_m+1
4906
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 i2_t = min(i1_t+len_thread_m-1,len)
4907 !
4908
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=i1_t,i2_t
4909
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 9309 times.
✓ Branch 7 taken 4515 times.
13824 if(slianl(i).eq.0.) then
4910 !.... tsffc2 is the previous anomaly + today's climatology
4911 ! tsffc2 = (tsffcs(i)-tsfan2(i))+tsfanl(i)
4912 ! tsfanl(i) = tsffc2 *rtsfs+tsfanl(i)*qtsfs
4913 !
4914
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 9309 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9309 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9309 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9309 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 9309 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 9309 times.
9309 tsfanl(i) = tsffcs(i)*rtsfs + tsfanl(i)*qtsfs
4915 ! albanl(i) = albfcs(i)*ralbs + albanl(i)*qalbs
4916
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 9309 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9309 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9309 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9309 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 9309 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 9309 times.
9309 aisanl(i) = aisfcs(i)*raiss + aisanl(i)*qaiss
4917
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 9309 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9309 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9309 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9309 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 9309 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 9309 times.
9309 snoanl(i) = snofcs(i)*rsnos + snoanl(i)*qsnos
4918
4919
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 9309 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9309 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9309 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9309 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 9309 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 9309 times.
9309 zoranl(i) = zorfcs(i)*rzors + zoranl(i)*qzors
4920
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 9309 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9309 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9309 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9309 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 9309 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 9309 times.
9309 veganl(i) = vegfcs(i)*rvegs + veganl(i)*qvegs
4921
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 9309 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9309 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9309 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9309 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 9309 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 9309 times.
9309 sihanl(i) = sihfcs(i)*rsihs + sihanl(i)*qsihs
4922
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 9309 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9309 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9309 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9309 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 9309 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 9309 times.
9309 sicanl(i) = sicfcs(i)*rsics + sicanl(i)*qsics
4923
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 9309 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9309 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9309 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9309 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 9309 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 9309 times.
9309 vmnanl(i) = vmnfcs(i)*rvmns + vmnanl(i)*qvmns
4924
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 9309 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9309 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9309 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9309 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 9309 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 9309 times.
9309 vmxanl(i) = vmxfcs(i)*rvmxs + vmxanl(i)*qvmxs
4925
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 9309 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9309 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9309 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9309 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 9309 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 9309 times.
9309 slpanl(i) = slpfcs(i)*rslps + slpanl(i)*qslps
4926
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 9309 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9309 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9309 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9309 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 9309 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 9309 times.
9309 absanl(i) = absfcs(i)*rabss + absanl(i)*qabss
4927 else
4928
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 4515 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4515 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4515 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4515 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4515 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4515 times.
4515 tsfanl(i) = tsffcs(i)*rtsfl + tsfanl(i)*qtsfl
4929 ! albanl(i) = albfcs(i)*ralbl + albanl(i)*qalbl
4930
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 4515 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4515 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4515 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4515 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4515 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4515 times.
4515 aisanl(i) = aisfcs(i)*raisl + aisanl(i)*qaisl
4931
1/2
✓ Branch 0 taken 4515 times.
✗ Branch 1 not taken.
4515 if(rsnol.ge.0)then
4932
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 4515 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4515 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4515 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4515 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4515 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4515 times.
4515 snoanl(i) = snofcs(i)*rsnol + snoanl(i)*qsnol
4933 else ! envelope method
4934 if(snoanl(i).ne.0)then
4935 snoanl(i) = max(-snoanl(i)/rsnol,
4936 & min(-snoanl(i)*rsnol, snofcs(i)))
4937 endif
4938 endif
4939
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 4515 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4515 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4515 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4515 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4515 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4515 times.
4515 zoranl(i) = zorfcs(i)*rzorl + zoranl(i)*qzorl
4940
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 4515 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4515 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4515 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4515 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4515 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4515 times.
4515 veganl(i) = vegfcs(i)*rvegl + veganl(i)*qvegl
4941
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 4515 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4515 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4515 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4515 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4515 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4515 times.
4515 vmnanl(i) = vmnfcs(i)*rvmnl + vmnanl(i)*qvmnl
4942
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 4515 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4515 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4515 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4515 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4515 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4515 times.
4515 vmxanl(i) = vmxfcs(i)*rvmxl + vmxanl(i)*qvmxl
4943
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 4515 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4515 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4515 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4515 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4515 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4515 times.
4515 slpanl(i) = slpfcs(i)*rslpl + slpanl(i)*qslpl
4944
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 4515 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4515 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4515 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4515 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4515 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4515 times.
4515 absanl(i) = absfcs(i)*rabsl + absanl(i)*qabsl
4945
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 4515 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4515 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4515 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4515 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4515 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4515 times.
4515 sihanl(i) = sihfcs(i)*rsihl + sihanl(i)*qsihl
4946
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 4515 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4515 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4515 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4515 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4515 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4515 times.
4515 sicanl(i) = sicfcs(i)*rsicl + sicanl(i)*qsicl
4947 endif
4948
4949
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 13824 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 13824 times.
13824 cnpanl(i) = cnpfcs(i)*rcnp + cnpanl(i)*qcnp
4950 !
4951 ! snow over sea ice is cycled
4952 !
4953
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 500 times.
✓ Branch 7 taken 13324 times.
13830 if(slianl(i).eq.2.) then
4954
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 500 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 500 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 500 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 500 times.
500 snoanl(i) = snofcs(i)
4955 endif
4956 !
4957 enddo
4958
4959 ! at landice points, set the soil type, slope type and
4960 ! greenness fields to flag values.
4961
4962
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (landice) then
4963
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=i1_t,i2_t
4964
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 4015 times.
✓ Branch 7 taken 9809 times.
13830 if (nint(slianl(i)) == 1) then
4965
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 4015 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4015 times.
✓ Branch 6 taken 319 times.
✓ Branch 7 taken 3696 times.
4015 if (nint(vetanl(i)) == veg_type_landice) then
4966
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 319 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 319 times.
319 sotanl(i) = soil_type_landice
4967
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 319 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 319 times.
319 veganl(i) = 0.0
4968
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 319 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 319 times.
319 slpanl(i) = 9.0
4969
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 319 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 319 times.
319 vmnanl(i) = 0.0
4970
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 319 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 319 times.
319 vmxanl(i) = 0.0
4971 endif
4972 end if ! if land
4973 enddo
4974 endif
4975
4976
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=i1_t,i2_t
4977
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 13824 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 13824 times.
13824 cvanl(i) = cvfcs(i)*rcv + cvanl(i)*qcv
4978
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 13824 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 13824 times.
13824 cvbanl(i) = cvbfcs(i)*rcvb + cvbanl(i)*qcvb
4979
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 13824 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 13824 times.
13830 cvtanl(i) = cvtfcs(i)*rcvt + cvtanl(i)*qcvt
4980 enddo
4981 !
4982
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do k = 1, 4
4983
2/2
✓ Branch 0 taken 55296 times.
✓ Branch 1 taken 24 times.
55326 do i=i1_t,i2_t
4984
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✓ Branch 6 taken 37236 times.
✓ Branch 7 taken 18060 times.
55320 if(slianl(i).eq.0.) then
4985
12/24
✗ Branch 0 not taken.
✓ Branch 1 taken 37236 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 37236 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 37236 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 37236 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 37236 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 37236 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 37236 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 37236 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 37236 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 37236 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 37236 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 37236 times.
37236 albanl(i,k) = albfcs(i,k)*ralbs + albanl(i,k)*qalbs
4986 else
4987
12/24
✗ Branch 0 not taken.
✓ Branch 1 taken 18060 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 18060 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 18060 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 18060 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 18060 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 18060 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 18060 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 18060 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 18060 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 18060 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 18060 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 18060 times.
18060 albanl(i,k) = albfcs(i,k)*ralbl + albanl(i,k)*qalbl
4988 endif
4989 enddo
4990 enddo
4991 !
4992
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 6 times.
18 do k = 1, 2
4993
2/2
✓ Branch 0 taken 27648 times.
✓ Branch 1 taken 12 times.
27666 do i=i1_t,i2_t
4994
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
✓ Branch 6 taken 18618 times.
✓ Branch 7 taken 9030 times.
27660 if(slianl(i).eq.0.) then
4995
12/24
✗ Branch 0 not taken.
✓ Branch 1 taken 18618 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 18618 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 18618 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 18618 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 18618 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 18618 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 18618 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 18618 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 18618 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 18618 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 18618 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 18618 times.
18618 alfanl(i,k) = alffcs(i,k)*ralfs + alfanl(i,k)*qalfs
4996 else
4997
12/24
✗ Branch 0 not taken.
✓ Branch 1 taken 9030 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9030 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9030 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9030 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 9030 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 9030 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 9030 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 9030 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 9030 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 9030 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 9030 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 9030 times.
9030 alfanl(i,k) = alffcs(i,k)*ralfl + alfanl(i,k)*qalfl
4998 endif
4999 enddo
5000 enddo
5001 !
5002
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
36 do k = 1, lsoil
5003
2/2
✓ Branch 0 taken 55296 times.
✓ Branch 1 taken 24 times.
55326 do i=i1_t,i2_t
5004
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✓ Branch 6 taken 37236 times.
✓ Branch 7 taken 18060 times.
55320 if(slianl(i).eq.0.) then
5005
16/32
✗ Branch 0 not taken.
✓ Branch 1 taken 37236 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 37236 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 37236 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 37236 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 37236 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 37236 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 37236 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 37236 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 37236 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 37236 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 37236 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 37236 times.
✗ Branch 36 not taken.
✓ Branch 37 taken 37236 times.
✗ Branch 39 not taken.
✓ Branch 40 taken 37236 times.
✗ Branch 42 not taken.
✓ Branch 43 taken 37236 times.
✗ Branch 45 not taken.
✓ Branch 46 taken 37236 times.
37236 smcanl(i,k) = smcfcs(i,k)*rsmcs(k) + smcanl(i,k)*qsmcs(k)
5006
16/32
✗ Branch 0 not taken.
✓ Branch 1 taken 37236 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 37236 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 37236 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 37236 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 37236 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 37236 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 37236 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 37236 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 37236 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 37236 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 37236 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 37236 times.
✗ Branch 36 not taken.
✓ Branch 37 taken 37236 times.
✗ Branch 39 not taken.
✓ Branch 40 taken 37236 times.
✗ Branch 42 not taken.
✓ Branch 43 taken 37236 times.
✗ Branch 45 not taken.
✓ Branch 46 taken 37236 times.
37236 stcanl(i,k) = stcfcs(i,k)*rstcs(k) + stcanl(i,k)*qstcs(k)
5007 else
5008 ! soil moisture not used at landice points, so
5009 ! don't bother merging it. also, for now don't allow nudging
5010 ! to raise subsurface temperature above freezing.
5011
16/32
✗ Branch 0 not taken.
✓ Branch 1 taken 18060 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 18060 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 18060 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 18060 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 18060 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 18060 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 18060 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 18060 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 18060 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 18060 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 18060 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 18060 times.
✗ Branch 36 not taken.
✓ Branch 37 taken 18060 times.
✗ Branch 39 not taken.
✓ Branch 40 taken 18060 times.
✗ Branch 42 not taken.
✓ Branch 43 taken 18060 times.
✗ Branch 45 not taken.
✓ Branch 46 taken 18060 times.
18060 stcanl(i,k) = stcfcs(i,k)*rstcl(k) + stcanl(i,k)*qstcl(k)
5012
7/10
✗ Branch 0 not taken.
✓ Branch 1 taken 18060 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 18060 times.
✓ Branch 6 taken 18060 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 16060 times.
✓ Branch 9 taken 2000 times.
✓ Branch 10 taken 1276 times.
✓ Branch 11 taken 14784 times.
36120 if (landice .and. slianl(i) == 1.0 .and.
5013
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 18060 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 18060 times.
18060 & nint(vetanl(i)) == veg_type_landice) then
5014
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 1276 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1276 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1276 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1276 times.
1276 smcanl(i,k) = 1.0 ! use value as flag
5015
9/18
✗ Branch 0 not taken.
✓ Branch 1 taken 1276 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1276 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1276 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1276 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1276 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 1276 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 1276 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 1276 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 1276 times.
1276 stcanl(i,k) = min(stcanl(i,k), 273.15)
5016 else
5017
16/32
✗ Branch 0 not taken.
✓ Branch 1 taken 16784 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 16784 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 16784 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 16784 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 16784 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 16784 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 16784 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 16784 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 16784 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 16784 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 16784 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 16784 times.
✗ Branch 36 not taken.
✓ Branch 37 taken 16784 times.
✗ Branch 39 not taken.
✓ Branch 40 taken 16784 times.
✗ Branch 42 not taken.
✓ Branch 43 taken 16784 times.
✗ Branch 45 not taken.
✓ Branch 46 taken 16784 times.
16784 smcanl(i,k) = smcfcs(i,k)*rsmcl(k) + smcanl(i,k)*qsmcl(k)
5018 end if
5019 endif
5020 enddo
5021 enddo
5022 !
5023 enddo ! end of threaded loop ...................
5024 !$omp end parallel do
5025 12 return
5026 end subroutine merge
5027 12 subroutine newice(slianl,slifcs,tsfanl,tsffcs,len,lsoil,
5028 !cwu [+1l] add sihnew,sicnew,sihanl,sicanl
5029 6 & sihnew,sicnew,sihanl,sicanl,
5030 6 & albanl,snoanl,zoranl,smcanl,stcanl,
5031 & albsea,snosea,zorsea,smcsea,smcice,
5032 & tsfmin,tsfice,albice,zorice,tgice,
5033 6 & rla,rlo,me)
5034 !
5035 use machine , only : kind_io8,kind_io4
5036 implicit none
5037 real (kind=kind_io8), parameter :: one=1.0
5038 real (kind=kind_io8) tgice,albice,zorice,tsfice,albsea,snosea,
5039 & smcice,tsfmin,zorsea,smcsea
5040 !cwu [+1l] add sicnew,sihnew
5041 &, sicnew,sihnew
5042 6 integer i,me,kount1,kount2,k,len,lsoil
5043 real (kind=kind_io8) slianl(len), slifcs(len),
5044 & tsffcs(len),tsfanl(len)
5045 real (kind=kind_io8) albanl(len,4), snoanl(len), zoranl(len)
5046 real (kind=kind_io8) smcanl(len,lsoil), stcanl(len,lsoil)
5047 !cwu [+1l] add sihanl & sicanl
5048 real (kind=kind_io8) sihanl(len), sicanl(len)
5049 !
5050 real (kind=kind_io8) rla(len), rlo(len)
5051 !
5052
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) write(6,*) 'newice'
5053 !
5054 6 kount1 = 0
5055 6 kount2 = 0
5056
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
5057
5/10
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 13824 times.
13830 if(slifcs(i).ne.slianl(i)) then
5058 if(slifcs(i).eq.1..or.slianl(i).eq.1.) then
5059 print *,'inconsistency in slifcs or slianl'
5060 print 910,rla(i),rlo(i),slifcs(i),slianl(i),
5061 & tsffcs(i),tsfanl(i)
5062 910 format(2x,'at lat=',f5.1,' lon=',f5.1,' slifcs=',f4.1,
5063 & ' slimsk=',f4.1,' tsffcs=',f5.1,' set to tsfanl=',f5.1)
5064 call abort
5065 endif
5066 !
5067 ! interpolated climatology indicates melted sea ice
5068 !
5069 if(slianl(i).eq.0..and.slifcs(i).eq.2.) then
5070 tsfanl(i) = tsfmin
5071 albanl(i,1) = albsea
5072 albanl(i,2) = albsea
5073 albanl(i,3) = albsea
5074 albanl(i,4) = albsea
5075 snoanl(i) = snosea
5076 zoranl(i) = zorsea
5077 do k = 1, lsoil
5078 smcanl(i,k) = smcsea
5079 !cwu [+1l] set stcanl to tgice (over sea-ice)
5080 stcanl(i,k) = tgice
5081 enddo
5082 !cwu [+2l] set siganl and sicanl
5083 sihanl(i) = 0.
5084 sicanl(i) = 0.
5085 kount1 = kount1 + 1
5086 endif
5087 !
5088 ! interplated climatoloyg/analysis indicates new sea ice
5089 !
5090 if(slianl(i).eq.2..and.slifcs(i).eq.0.) then
5091 tsfanl(i) = tsfice
5092 albanl(i,1) = albice
5093 albanl(i,2) = albice
5094 albanl(i,3) = albice
5095 albanl(i,4) = albice
5096 snoanl(i) = 0.
5097 zoranl(i) = zorice
5098 do k = 1, lsoil
5099 smcanl(i,k) = smcice
5100 stcanl(i,k) = tgice
5101 enddo
5102 !cwu [+2l] add sihanl & sicanl
5103 sihanl(i) = sihnew
5104 sicanl(i) = min(one, max(sicnew,sicanl(i)))
5105 kount2 = kount2 + 1
5106 endif
5107 endif
5108 enddo
5109 !
5110
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
5111
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 if(kount1.gt.0) then
5112 write(6,*) 'sea ice melted. tsf,alb,zor are filled',
5113 & ' at ',kount1,' points'
5114 endif
5115
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 if(kount2.gt.0) then
5116 write(6,*) 'sea ice formed. tsf,alb,zor are filled',
5117 & ' at ',kount2,' points'
5118 endif
5119 endif
5120 !
5121 6 return
5122 end
5123 18 subroutine qcsnow(snoanl,slmask,aisanl,glacir,len,snoval,
5124 & landice,me)
5125 use machine , only : kind_io8,kind_io4
5126 implicit none
5127 18 integer kount,i,len,me
5128 logical, intent(in) :: landice
5129 18 real (kind=kind_io8) per,snoval
5130 real (kind=kind_io8) snoanl(len),slmask(len),
5131 & aisanl(len),glacir(len)
5132
2/2
✓ Branch 0 taken 3 times.
✓ Branch 1 taken 15 times.
18 if (me .eq. 0) then
5133 3 write(6,*) ' '
5134 3 write(6,*) 'qc of snow'
5135 endif
5136
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 18 times.
18 if (.not.landice) then
5137 kount=0
5138 do i=1,len
5139 if(glacir(i).ne.0..and.snoanl(i).eq.0.) then
5140 ! if(glacir(i).ne.0..and.snoanl(i).lt.snoval*0.5) then
5141 snoanl(i) = snoval
5142 kount = kount + 1
5143 endif
5144 enddo
5145 per = float(kount) / float(len)*100.
5146 if(kount.gt.0) then
5147 if (me .eq. 0) then
5148 print *,'snow filled over glacier points at ',kount,
5149 & ' points (',per,'percent)'
5150 endif
5151 endif
5152 endif ! landice check
5153 18 kount = 0
5154
2/2
✓ Branch 0 taken 41472 times.
✓ Branch 1 taken 18 times.
41490 do i=1,len
5155
8/12
✗ Branch 0 not taken.
✓ Branch 1 taken 41472 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 41472 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 41472 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 41472 times.
✓ Branch 12 taken 29427 times.
✓ Branch 13 taken 12045 times.
✓ Branch 14 taken 27555 times.
✓ Branch 15 taken 1872 times.
41490 if(slmask(i).eq.0.and.aisanl(i).eq.0) then
5156
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 27555 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27555 times.
27555 snoanl(i) = 0.
5157 27555 kount = kount + 1
5158 endif
5159 enddo
5160 18 per = float(kount) / float(len)*100.
5161
1/2
✓ Branch 0 taken 18 times.
✗ Branch 1 not taken.
18 if(kount.gt.0) then
5162
2/2
✓ Branch 0 taken 3 times.
✓ Branch 1 taken 15 times.
18 if (me .eq. 0) then
5163 3 print *,'snow set to zero over open sea at ',kount,
5164 6 & ' points (',per,'percent)'
5165 endif
5166 endif
5167 18 return
5168 end subroutine qcsnow
5169 24 subroutine qcsice(ais,glacir,amxice,aicice,aicsea,sllnd,slmask,
5170 12 & rla,rlo,len,me)
5171 use machine , only : kind_io8,kind_io4
5172 implicit none
5173 12 integer kount1,kount,i,me,len
5174 12 real (kind=kind_io8) per,aicsea,aicice,sllnd
5175 !
5176 real (kind=kind_io8) ais(len), glacir(len),
5177 & amxice(len), slmask(len)
5178 real (kind=kind_io8) rla(len), rlo(len)
5179 !
5180 ! check sea-ice cover mask against land-sea mask
5181 !
5182
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 10 times.
12 if (me .eq. 0) write(6,*) 'qc of sea ice'
5183 12 kount = 0
5184 12 kount1 = 0
5185
2/2
✓ Branch 0 taken 27648 times.
✓ Branch 1 taken 12 times.
27660 do i=1,len
5186
7/12
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 27648 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 27648 times.
✓ Branch 12 taken 22385 times.
✓ Branch 13 taken 5263 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 22385 times.
27648 if(ais(i).ne.aicice.and.ais(i).ne.aicsea) then
5187 print *,'sea ice mask not ',aicice,' or ',aicsea
5188 print *,'ais(i),aicice,aicsea,rla(i),rlo(i,=',
5189 & ais(i),aicice,aicsea,rla(i),rlo(i)
5190 call abort
5191 endif
5192
11/18
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 27648 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 27648 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 27648 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 27648 times.
✓ Branch 18 taken 19618 times.
✓ Branch 19 taken 8030 times.
✓ Branch 20 taken 8 times.
✓ Branch 21 taken 19610 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 8 times.
27648 if(slmask(i).eq.0..and.glacir(i).eq.1..and.
5193 ! if(slmask(i).eq.0..and.glacir(i).eq.2..and.
5194 & ais(i).ne.1.) then
5195 kount1 = kount1 + 1
5196 ais(i) = 1.
5197 endif
5198
8/12
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 27648 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 27648 times.
✓ Branch 12 taken 8030 times.
✓ Branch 13 taken 19618 times.
✓ Branch 14 taken 4015 times.
✓ Branch 15 taken 4015 times.
27660 if(slmask(i).eq.sllnd.and.ais(i).eq.aicice) then
5199 4015 kount = kount + 1
5200
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 4015 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4015 times.
4015 ais(i) = aicsea
5201 endif
5202 enddo
5203 ! enddo
5204 12 per = float(kount) / float(len)*100.
5205
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
12 if(kount.gt.0) then
5206
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if(me .eq. 0) then
5207 1 print *,' sea ice over land mask at ',kount,' points (',per,
5208 2 & 'percent)'
5209 endif
5210 endif
5211 12 per = float(kount1) / float(len)*100.
5212
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
12 if(kount1.gt.0) then
5213 if(me .eq. 0) then
5214 print *,' sea ice set over glacier points over ocean at ',
5215 & kount1,' points (',per,'percent)'
5216 endif
5217 endif
5218 ! kount=0
5219 ! do j=1,jdim
5220 ! do i=1,idim
5221 ! if(amxice(i,j).ne.0..and.ais(i,j).eq.0.) then
5222 ! ais(i,j)=0.
5223 ! kount=kount+1
5224 ! endif
5225 ! enddo
5226 ! enddo
5227 ! per=float(kount)/float(idim*jdim)*100.
5228 ! if(kount.gt.0) then
5229 ! print *,' sea ice exceeds maxice at ',kount,' points (',per,
5230 ! & 'percent)'
5231 ! endif
5232 !
5233 ! remove isolated open ocean surrounded by sea ice and/or land
5234 !
5235 ! remove isolated open ocean surrounded by sea ice and/or land
5236 !
5237 ! ij = 0
5238 ! do j=1,jdim
5239 ! do i=1,idim
5240 ! ij = ij + 1
5241 ! ip = i + 1
5242 ! im = i - 1
5243 ! jp = j + 1
5244 ! jm = j - 1
5245 ! if(jp.gt.jdim) jp = jdim - 1
5246 ! if(jm.lt.1) jm = 2
5247 ! if(ip.gt.idim) ip = 1
5248 ! if(im.lt.1) im = idim
5249 ! if(slmask(i,j).eq.0..and.ais(i,j).eq.0.) then
5250 ! if((slmask(ip,jp).eq.1..or.ais(ip,jp).eq.1.).and.
5251 ! & (slmask(i ,jp).eq.1..or.ais(i ,jp).eq.1.).and.
5252 ! & (slmask(im,jp).eq.1..or.ais(im,jp).eq.1.).and.
5253 ! & (slmask(ip,j ).eq.1..or.ais(ip,j ).eq.1.).and.
5254 ! & (slmask(im,j ).eq.1..or.ais(im,j ).eq.1.).and.
5255 ! & (slmask(ip,jm).eq.1..or.ais(ip,jm).eq.1.).and.
5256 ! & (slmask(i ,jm).eq.1..or.ais(i ,jm).eq.1.).and.
5257 ! & (slmask(im,jm).eq.1..or.ais(im,jm).eq.1.)) then
5258 ! ais(i,j) = 1.
5259 ! write(6,*) ' isolated open sea point surrounded by',
5260 ! & ' sea ice or land modified to sea ice',
5261 ! & ' at lat=',rla(i,j),' lon=',rlo(i,j)
5262 ! endif
5263 ! endif
5264 ! enddo
5265 ! enddo
5266 12 return
5267 end
5268 12 subroutine setlsi(slmask,aisfld,len,aicice,slifld)
5269 !
5270 use machine , only : kind_io8,kind_io4
5271 implicit none
5272 12 integer i,len
5273 real (kind=kind_io8) aicice
5274 real (kind=kind_io8) slmask(len), slifld(len), aisfld(len)
5275 !
5276 ! set surface condition indicator slimsk
5277 !
5278
2/2
✓ Branch 0 taken 27648 times.
✓ Branch 1 taken 12 times.
27660 do i=1,len
5279
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 27648 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 27648 times.
27648 slifld(i) = slmask(i)
5280 ! if(aisfld(i).eq.aicice) slifld(i) = 2.0
5281
7/12
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 27648 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 27648 times.
✓ Branch 12 taken 1248 times.
✓ Branch 13 taken 26400 times.
✓ Branch 14 taken 1248 times.
✗ Branch 15 not taken.
27648 if(aisfld(i).eq.aicice .and. slmask(i) .eq. 0.0)
5282
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1248 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1248 times.
1260 & slifld(i) = 2.0
5283 enddo
5284 12 return
5285 end
5286 180 subroutine scale(fld,len,scl)
5287 !
5288 use machine , only : kind_io8,kind_io4
5289 implicit none
5290 180 integer i,len
5291 real (kind=kind_io8) fld(len),scl
5292
2/2
✓ Branch 0 taken 414720 times.
✓ Branch 1 taken 180 times.
414900 do i=1,len
5293
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 414720 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 414720 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 414720 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 414720 times.
414900 fld(i) = fld(i) * scl
5294 enddo
5295 180 return
5296 end
5297
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 606 times.
1818 subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg,
5298 & fldlmx,fldlmn,fldomx,fldomn,fldimx,fldimn,
5299 & fldjmx,fldjmn,fldsmx,fldsmn,epsfld,
5300 606 & rla,rlo,len,mode,percrit,lgchek,me)
5301 !
5302 use machine , only : kind_io8,kind_io4
5303 implicit none
5304 606 real (kind=kind_io8) permax,per,fldimx,fldimn,fldjmx,fldomn,
5305 & fldlmx,fldlmn,fldomx,fldjmn,percrit,
5306 & fldsmx,fldsmn,epsfld
5307 1212 integer kmaxi,kmini,kmaxj,kmino,kmaxl,kminl,kmaxo,mmprt,kminj,
5308 3030 & ij,nprt,kmaxs,kmins,i,me,len,mode
5309 parameter(mmprt=2)
5310 !
5311 character*8 ttl
5312 logical iceflg(len)
5313 real (kind=kind_io8) fld(len),slimsk(len),sno(len),
5314 & rla(len), rlo(len)
5315
5/8
✗ Branch 0 not taken.
✓ Branch 1 taken 606 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 606 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 606 times.
✓ Branch 9 taken 1396224 times.
✓ Branch 10 taken 606 times.
1818 integer iwk(len)
5316 logical lgchek
5317 !
5318 logical first
5319 integer num_threads
5320 data first /.true./
5321 save num_threads, first
5322 !
5323 1818 integer len_thread_m, i1_t, i2_t, it
5324 integer num_parthds
5325 !
5326
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 600 times.
606 if (first) then
5327 6 num_threads = num_parthds()
5328 6 first = .false.
5329 endif
5330 !
5331 ! check against land-sea mask and ice cover mask
5332 !
5333
2/2
✓ Branch 0 taken 101 times.
✓ Branch 1 taken 505 times.
606 if(me .eq. 0) then
5334 ! print *,' '
5335 101 print *,'performing qc of ',ttl,' mode=',mode,
5336 202 & '(0=count only, 1=replace)'
5337 endif
5338 !
5339 606 len_thread_m = (len+num_threads-1) / num_threads
5340 606 kmaxl = 0
5341 606 kminl = 0
5342 606 kmaxo = 0
5343 606 kmino = 0
5344 606 kmaxi = 0
5345 606 kmini = 0
5346 606 kmaxj = 0
5347 606 kminj = 0
5348 606 kmaxs = 0
5349 606 kmins = 0
5350 !$omp parallel do private(i1_t,i2_t,it,i)
5351 !$omp+private(nprt,ij,iwk)
5352 !$omp+reduction(+:kmaxs,kmins,kmaxl,kminl,kmaxo)
5353 !$omp+reduction(+:kmino,kmaxi,kmini,kmaxj,kminj)
5354 !$omp+shared(mode,epsfld)
5355 !$omp+shared(fldlmx,fldlmn,fldomx,fldjmn,fldsmx,fldsmn)
5356 !$omp+shared(fld,slimsk,sno,rla,rlo)
5357
2/2
✓ Branch 0 taken 606 times.
✓ Branch 1 taken 606 times.
1212 do it=1,num_threads ! start of threaded loop
5358 606 i1_t = (it-1)*len_thread_m+1
5359
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 606 times.
606 i2_t = min(i1_t+len_thread_m-1,len)
5360 !
5361 !
5362 !
5363 ! lower bound check over bare land
5364 !
5365
1/2
✓ Branch 0 taken 606 times.
✗ Branch 1 not taken.
606 if (fldlmn .ne. 999.0) then
5366
2/2
✓ Branch 0 taken 1396224 times.
✓ Branch 1 taken 606 times.
1396830 do i=i1_t,i2_t
5367
11/18
✗ Branch 0 not taken.
✓ Branch 1 taken 1396224 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1396224 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1396224 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1396224 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1396224 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 1396224 times.
✓ Branch 18 taken 405515 times.
✓ Branch 19 taken 990709 times.
✓ Branch 20 taken 368173 times.
✓ Branch 21 taken 37342 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 368173 times.
1396224 if(slimsk(i).eq.1..and.sno(i).le.0..and.
5368 606 & fld(i).lt.fldlmn-epsfld) then
5369 kminl=kminl+1
5370 iwk(kminl) = i
5371 endif
5372 enddo
5373
4/6
✓ Branch 0 taken 101 times.
✓ Branch 1 taken 505 times.
✓ Branch 2 taken 101 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 101 times.
✗ Branch 5 not taken.
606 if(me == 0 . and. it == 1 .and. num_threads == 1) then
5374
1/2
✓ Branch 0 taken 101 times.
✗ Branch 1 not taken.
101 nprt = min(mmprt,kminl)
5375
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 do i=1,nprt
5376 ij = iwk(i)
5377
0/12
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
101 print 8001,rla(ij),rlo(ij),fld(ij),fldlmn
5378 8001 format(' bare land min. check. lat=',f5.1,
5379 & ' lon=',f6.1,' fld=',e13.6, ' to ',e13.6)
5380 enddo
5381 endif
5382
2/2
✓ Branch 0 taken 516 times.
✓ Branch 1 taken 90 times.
606 if (mode .eq. 1) then
5383
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 516 times.
516 do i=1,kminl
5384
0/8
✗ Branch 0 not taken.
✗ Branch 1 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
516 fld(iwk(i)) = fldlmn
5385 enddo
5386 endif
5387 endif
5388 !
5389 ! upper bound check over bare land
5390 !
5391
1/2
✓ Branch 0 taken 606 times.
✗ Branch 1 not taken.
606 if (fldlmx .ne. 999.0) then
5392
2/2
✓ Branch 0 taken 1396224 times.
✓ Branch 1 taken 606 times.
1396830 do i=i1_t,i2_t
5393
12/18
✗ Branch 0 not taken.
✓ Branch 1 taken 1396224 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1396224 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1396224 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1396224 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1396224 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 1396224 times.
✓ Branch 18 taken 405515 times.
✓ Branch 19 taken 990709 times.
✓ Branch 20 taken 368173 times.
✓ Branch 21 taken 37342 times.
✓ Branch 22 taken 7297 times.
✓ Branch 23 taken 360876 times.
1396224 if(slimsk(i).eq.1..and.sno(i).le.0..and.
5394 606 & fld(i).gt.fldlmx+epsfld) then
5395 7297 kmaxl=kmaxl+1
5396
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 7297 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 7297 times.
7297 iwk(kmaxl) = i
5397 endif
5398 enddo
5399
4/6
✓ Branch 0 taken 101 times.
✓ Branch 1 taken 505 times.
✓ Branch 2 taken 101 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 101 times.
✗ Branch 5 not taken.
606 if(me == 0 . and. it == 1 .and. num_threads == 1) then
5400
2/2
✓ Branch 0 taken 99 times.
✓ Branch 1 taken 2 times.
101 nprt = min(mmprt,kmaxl)
5401
2/2
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 101 times.
105 do i=1,nprt
5402
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 4 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4 times.
4 ij = iwk(i)
5403
6/12
✗ Branch 1 not taken.
✓ Branch 2 taken 4 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 4 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 4 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 4 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 4 times.
105 print 8002,rla(ij),rlo(ij),fld(ij),fldlmx
5404 8002 format(' bare land max. check. lat=',f5.1,
5405 & ' lon=',f6.1,' fld=',e13.6, ' to ',e13.6)
5406 enddo
5407 endif
5408
2/2
✓ Branch 0 taken 516 times.
✓ Branch 1 taken 90 times.
606 if (mode .eq. 1) then
5409
2/2
✓ Branch 0 taken 7297 times.
✓ Branch 1 taken 516 times.
7813 do i=1,kmaxl
5410
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 7297 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 7297 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 7297 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 7297 times.
7813 fld(iwk(i)) = fldlmx
5411 enddo
5412 endif
5413 endif
5414 !
5415 ! lower bound check over snow covered land
5416 !
5417
1/2
✓ Branch 0 taken 606 times.
✗ Branch 1 not taken.
606 if (fldsmn .ne. 999.0) then
5418
2/2
✓ Branch 0 taken 1396224 times.
✓ Branch 1 taken 606 times.
1396830 do i=i1_t,i2_t
5419
11/18
✗ Branch 0 not taken.
✓ Branch 1 taken 1396224 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1396224 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1396224 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1396224 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1396224 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 1396224 times.
✓ Branch 18 taken 405515 times.
✓ Branch 19 taken 990709 times.
✓ Branch 20 taken 37342 times.
✓ Branch 21 taken 368173 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 37342 times.
1396224 if(slimsk(i).eq.1..and.sno(i).gt.0..and.
5420 606 & fld(i).lt.fldsmn-epsfld) then
5421 kmins=kmins+1
5422 iwk(kmins) = i
5423 endif
5424 enddo
5425
4/6
✓ Branch 0 taken 101 times.
✓ Branch 1 taken 505 times.
✓ Branch 2 taken 101 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 101 times.
✗ Branch 5 not taken.
606 if(me == 0 . and. it == 1 .and. num_threads == 1) then
5426
1/2
✓ Branch 0 taken 101 times.
✗ Branch 1 not taken.
101 nprt = min(mmprt,kmins)
5427
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 do i=1,nprt
5428 ij = iwk(i)
5429
0/12
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
101 print 8003,rla(ij),rlo(ij),fld(ij),fldsmn
5430 8003 format(' sno covrd land min. check. lat=',f5.1,
5431 & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4)
5432 enddo
5433 endif
5434
2/2
✓ Branch 0 taken 516 times.
✓ Branch 1 taken 90 times.
606 if (mode .eq. 1) then
5435
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 516 times.
516 do i=1,kmins
5436
0/8
✗ Branch 0 not taken.
✗ Branch 1 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
516 fld(iwk(i)) = fldsmn
5437 enddo
5438 endif
5439 endif
5440 !
5441 ! upper bound check over snow covered land
5442 !
5443
1/2
✓ Branch 0 taken 606 times.
✗ Branch 1 not taken.
606 if (fldsmx .ne. 999.0) then
5444
2/2
✓ Branch 0 taken 1396224 times.
✓ Branch 1 taken 606 times.
1396830 do i=i1_t,i2_t
5445
12/18
✗ Branch 0 not taken.
✓ Branch 1 taken 1396224 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1396224 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1396224 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1396224 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1396224 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 1396224 times.
✓ Branch 18 taken 405515 times.
✓ Branch 19 taken 990709 times.
✓ Branch 20 taken 37342 times.
✓ Branch 21 taken 368173 times.
✓ Branch 22 taken 3237 times.
✓ Branch 23 taken 34105 times.
1396224 if(slimsk(i).eq.1..and.sno(i).gt.0..and.
5446 606 & fld(i).gt.fldsmx+epsfld) then
5447 3237 kmaxs=kmaxs+1
5448
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 3237 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 3237 times.
3237 iwk(kmaxs) = i
5449 endif
5450 enddo
5451
4/6
✓ Branch 0 taken 101 times.
✓ Branch 1 taken 505 times.
✓ Branch 2 taken 101 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 101 times.
✗ Branch 5 not taken.
606 if(me == 0 . and. it == 1 .and. num_threads == 1) then
5452
1/2
✓ Branch 0 taken 101 times.
✗ Branch 1 not taken.
101 nprt = min(mmprt,kmaxs)
5453
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 do i=1,nprt
5454 ij = iwk(i)
5455
0/12
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
101 print 8004,rla(ij),rlo(ij),fld(ij),fldsmx
5456 8004 format(' snow land max. check. lat=',f5.1,
5457 & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4)
5458 enddo
5459 endif
5460
2/2
✓ Branch 0 taken 516 times.
✓ Branch 1 taken 90 times.
606 if (mode .eq. 1) then
5461
2/2
✓ Branch 0 taken 1961 times.
✓ Branch 1 taken 516 times.
2477 do i=1,kmaxs
5462
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 1961 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1961 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1961 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1961 times.
2477 fld(iwk(i)) = fldsmx
5463 enddo
5464 endif
5465 endif
5466 !
5467 ! lower bound check over open ocean
5468 !
5469
1/2
✓ Branch 0 taken 606 times.
✗ Branch 1 not taken.
606 if (fldomn .ne. 999.0) then
5470
2/2
✓ Branch 0 taken 1396224 times.
✓ Branch 1 taken 606 times.
1396830 do i=i1_t,i2_t
5471
8/12
✗ Branch 0 not taken.
✓ Branch 1 taken 1396224 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1396224 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1396224 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1396224 times.
✓ Branch 12 taken 933761 times.
✓ Branch 13 taken 462463 times.
✓ Branch 14 taken 45925 times.
✓ Branch 15 taken 887836 times.
1396224 if(slimsk(i).eq.0..and.
5472 606 & fld(i).lt.fldomn-epsfld) then
5473 45925 kmino=kmino+1
5474
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 45925 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 45925 times.
45925 iwk(kmino) = i
5475 endif
5476 enddo
5477
4/6
✓ Branch 0 taken 101 times.
✓ Branch 1 taken 505 times.
✓ Branch 2 taken 101 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 101 times.
✗ Branch 5 not taken.
606 if(me == 0 . and. it == 1 .and. num_threads == 1) then
5478
2/2
✓ Branch 0 taken 96 times.
✓ Branch 1 taken 5 times.
101 nprt = min(mmprt,kmino)
5479
2/2
✓ Branch 0 taken 10 times.
✓ Branch 1 taken 101 times.
111 do i=1,nprt
5480
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 10 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 10 times.
10 ij = iwk(i)
5481
6/12
✗ Branch 1 not taken.
✓ Branch 2 taken 10 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 10 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 10 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 10 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 10 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 10 times.
111 print 8005,rla(ij),rlo(ij),fld(ij),fldomn
5482 8005 format(' open ocean min. check. lat=',f5.1,
5483 & ' lon=',f6.1,' fld=',e11.4,' to ',e11.4)
5484 enddo
5485 endif
5486
2/2
✓ Branch 0 taken 516 times.
✓ Branch 1 taken 90 times.
606 if (mode .eq. 1) then
5487
2/2
✓ Branch 0 taken 45925 times.
✓ Branch 1 taken 516 times.
46441 do i=1,kmino
5488
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 45925 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 45925 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 45925 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 45925 times.
46441 fld(iwk(i)) = fldomn
5489 enddo
5490 endif
5491 endif
5492 !
5493 ! upper bound check over open ocean
5494 !
5495
1/2
✓ Branch 0 taken 606 times.
✗ Branch 1 not taken.
606 if (fldomx .ne. 999.0) then
5496
2/2
✓ Branch 0 taken 1396224 times.
✓ Branch 1 taken 606 times.
1396830 do i=i1_t,i2_t
5497
8/14
✗ Branch 0 not taken.
✓ Branch 1 taken 1396224 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1396224 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1396224 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1396224 times.
✓ Branch 12 taken 1396224 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 933761 times.
✓ Branch 15 taken 462463 times.
✗ Branch 16 not taken.
✓ Branch 17 taken 933761 times.
1396224 if(fldomx.ne.999..and.slimsk(i).eq.0..and.
5498 606 & fld(i).gt.fldomx+epsfld) then
5499 kmaxo=kmaxo+1
5500 iwk(kmaxo) = i
5501 endif
5502 enddo
5503
4/6
✓ Branch 0 taken 101 times.
✓ Branch 1 taken 505 times.
✓ Branch 2 taken 101 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 101 times.
✗ Branch 5 not taken.
606 if(me == 0 . and. it == 1 .and. num_threads == 1) then
5504
1/2
✓ Branch 0 taken 101 times.
✗ Branch 1 not taken.
101 nprt = min(mmprt,kmaxo)
5505
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 do i=1,nprt
5506 ij = iwk(i)
5507
0/12
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
101 print 8006,rla(ij),rlo(ij),fld(ij),fldomx
5508 8006 format(' open ocean max. check. lat=',f5.1,
5509 & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4)
5510 enddo
5511 endif
5512
2/2
✓ Branch 0 taken 516 times.
✓ Branch 1 taken 90 times.
606 if (mode .eq. 1) then
5513
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 516 times.
516 do i=1,kmaxo
5514
0/8
✗ Branch 0 not taken.
✗ Branch 1 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
516 fld(iwk(i)) = fldomx
5515 enddo
5516 endif
5517 endif
5518 !
5519 ! lower bound check over sea ice without snow
5520 !
5521
1/2
✓ Branch 0 taken 606 times.
✗ Branch 1 not taken.
606 if (fldimn .ne. 999.0) then
5522
2/2
✓ Branch 0 taken 1396224 times.
✓ Branch 1 taken 606 times.
1396830 do i=i1_t,i2_t
5523
12/18
✗ Branch 0 not taken.
✓ Branch 1 taken 1396224 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1396224 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1396224 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1396224 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1396224 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 1396224 times.
✓ Branch 18 taken 56948 times.
✓ Branch 19 taken 1339276 times.
✓ Branch 20 taken 23301 times.
✓ Branch 21 taken 33647 times.
✓ Branch 22 taken 3128 times.
✓ Branch 23 taken 20173 times.
1396224 if(slimsk(i).eq.2..and.sno(i).le.0..and.
5524 606 & fld(i).lt.fldimn-epsfld) then
5525 3128 kmini=kmini+1
5526
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 3128 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 3128 times.
3128 iwk(kmini) = i
5527 endif
5528 enddo
5529
4/6
✓ Branch 0 taken 101 times.
✓ Branch 1 taken 505 times.
✓ Branch 2 taken 101 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 101 times.
✗ Branch 5 not taken.
606 if(me == 0 . and. it == 1 .and. num_threads == 1) then
5530
1/2
✓ Branch 0 taken 101 times.
✗ Branch 1 not taken.
101 nprt = min(mmprt,kmini)
5531
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 do i=1,nprt
5532 ij = iwk(i)
5533
0/12
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
101 print 8007,rla(ij),rlo(ij),fld(ij),fldimn
5534 8007 format(' seaice no snow min. check lat=',f5.1,
5535 & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4)
5536 enddo
5537 endif
5538
2/2
✓ Branch 0 taken 516 times.
✓ Branch 1 taken 90 times.
606 if (mode .eq. 1) then
5539
2/2
✓ Branch 0 taken 3120 times.
✓ Branch 1 taken 516 times.
3636 do i=1,kmini
5540
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 3120 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 3120 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 3120 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 3120 times.
3636 fld(iwk(i)) = fldimn
5541 enddo
5542 endif
5543 endif
5544 !
5545 ! upper bound check over sea ice without snow
5546 !
5547
1/2
✓ Branch 0 taken 606 times.
✗ Branch 1 not taken.
606 if (fldimx .ne. 999.0) then
5548
2/2
✓ Branch 0 taken 1396224 times.
✓ Branch 1 taken 606 times.
1396830 do i=i1_t,i2_t
5549
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 1396224 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1396224 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1396224 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1396224 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1396224 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 1396224 times.
1396224 if(slimsk(i).eq.2..and.sno(i).le.0..and.
5550
10/12
✗ Branch 0 not taken.
✓ Branch 1 taken 1396224 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1396224 times.
✓ Branch 6 taken 56948 times.
✓ Branch 7 taken 1339276 times.
✓ Branch 8 taken 23301 times.
✓ Branch 9 taken 33647 times.
✓ Branch 10 taken 1437 times.
✓ Branch 11 taken 21864 times.
✓ Branch 12 taken 23 times.
✓ Branch 13 taken 1414 times.
1396830 & fld(i).gt.fldimx+epsfld .and. iceflg(i)) then
5551 ! & fld(i).gt.fldimx+epsfld) then
5552 23 kmaxi=kmaxi+1
5553
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 23 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 23 times.
23 iwk(kmaxi) = i
5554 endif
5555 enddo
5556
4/6
✓ Branch 0 taken 101 times.
✓ Branch 1 taken 505 times.
✓ Branch 2 taken 101 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 101 times.
✗ Branch 5 not taken.
606 if(me == 0 . and. it == 1 .and. num_threads == 1) then
5557
1/2
✓ Branch 0 taken 101 times.
✗ Branch 1 not taken.
101 nprt = min(mmprt,kmaxi)
5558
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 do i=1,nprt
5559 ij = iwk(i)
5560
0/12
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
101 print 8008,rla(ij),rlo(ij),fld(ij),fldimx
5561 8008 format(' seaice no snow max. check lat=',f5.1,
5562 & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4)
5563 enddo
5564 endif
5565
2/2
✓ Branch 0 taken 516 times.
✓ Branch 1 taken 90 times.
606 if (mode .eq. 1) then
5566
2/2
✓ Branch 0 taken 23 times.
✓ Branch 1 taken 516 times.
539 do i=1,kmaxi
5567
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 23 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 23 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 23 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 23 times.
539 fld(iwk(i)) = fldimx
5568 enddo
5569 endif
5570 endif
5571 !
5572 ! lower bound check over sea ice with snow
5573 !
5574
1/2
✓ Branch 0 taken 606 times.
✗ Branch 1 not taken.
606 if (fldjmn .ne. 999.0) then
5575
2/2
✓ Branch 0 taken 1396224 times.
✓ Branch 1 taken 606 times.
1396830 do i=i1_t,i2_t
5576
12/18
✗ Branch 0 not taken.
✓ Branch 1 taken 1396224 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1396224 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1396224 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1396224 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1396224 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 1396224 times.
✓ Branch 18 taken 56948 times.
✓ Branch 19 taken 1339276 times.
✓ Branch 20 taken 33647 times.
✓ Branch 21 taken 23301 times.
✓ Branch 22 taken 29 times.
✓ Branch 23 taken 33618 times.
1396224 if(slimsk(i).eq.2..and.sno(i).gt.0..and.
5577 606 & fld(i).lt.fldjmn-epsfld) then
5578 29 kminj=kminj+1
5579
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 29 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 29 times.
29 iwk(kminj) = i
5580 endif
5581 enddo
5582
4/6
✓ Branch 0 taken 101 times.
✓ Branch 1 taken 505 times.
✓ Branch 2 taken 101 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 101 times.
✗ Branch 5 not taken.
606 if(me == 0 . and. it == 1 .and. num_threads == 1) then
5583
1/2
✓ Branch 0 taken 101 times.
✗ Branch 1 not taken.
101 nprt = min(mmprt,kminj)
5584
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 do i=1,nprt
5585 ij = iwk(i)
5586
0/12
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
101 print 8009,rla(ij),rlo(ij),fld(ij),fldjmn
5587 8009 format(' sea ice snow min. check lat=',f5.1,
5588 & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4)
5589 enddo
5590 endif
5591
2/2
✓ Branch 0 taken 516 times.
✓ Branch 1 taken 90 times.
606 if (mode .eq. 1) then
5592
2/2
✓ Branch 0 taken 17 times.
✓ Branch 1 taken 516 times.
533 do i=1,kminj
5593
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 17 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 17 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 17 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 17 times.
533 fld(iwk(i)) = fldjmn
5594 enddo
5595 endif
5596 endif
5597 !
5598 ! upper bound check over sea ice with snow
5599 !
5600
1/2
✓ Branch 0 taken 606 times.
✗ Branch 1 not taken.
1212 if (fldjmx .ne. 999.0) then
5601
2/2
✓ Branch 0 taken 1396224 times.
✓ Branch 1 taken 606 times.
1396830 do i=i1_t,i2_t
5602
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 1396224 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1396224 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1396224 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1396224 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1396224 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 1396224 times.
1396224 if(slimsk(i).eq.2..and.sno(i).gt.0..and.
5603
10/12
✗ Branch 0 not taken.
✓ Branch 1 taken 1396224 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1396224 times.
✓ Branch 6 taken 56948 times.
✓ Branch 7 taken 1339276 times.
✓ Branch 8 taken 33647 times.
✓ Branch 9 taken 23301 times.
✓ Branch 10 taken 86 times.
✓ Branch 11 taken 33561 times.
✓ Branch 12 taken 4 times.
✓ Branch 13 taken 82 times.
1396830 & fld(i).gt.fldjmx+epsfld .and. iceflg(i)) then
5604 ! & fld(i).gt.fldjmx+epsfld) then
5605 4 kmaxj=kmaxj+1
5606
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 4 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4 times.
4 iwk(kmaxj) = i
5607 endif
5608 enddo
5609
4/6
✓ Branch 0 taken 101 times.
✓ Branch 1 taken 505 times.
✓ Branch 2 taken 101 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 101 times.
✗ Branch 5 not taken.
606 if(me == 0 .and. it == 1 .and. num_threads == 1) then
5610
1/2
✓ Branch 0 taken 101 times.
✗ Branch 1 not taken.
101 nprt = min(mmprt,kmaxj)
5611
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 do i=1,nprt
5612 ij = iwk(i)
5613
0/12
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
101 print 8010,rla(ij),rlo(ij),fld(ij),fldjmx
5614 8010 format(' seaice snow max check lat=',f5.1,
5615 & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4)
5616 enddo
5617 endif
5618
2/2
✓ Branch 0 taken 516 times.
✓ Branch 1 taken 90 times.
606 if (mode .eq. 1) then
5619
2/2
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 516 times.
520 do i=1,kmaxj
5620
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 4 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4 times.
520 fld(iwk(i)) = fldjmx
5621 enddo
5622 endif
5623 endif
5624 enddo ! end of threaded loop
5625 !$omp end parallel do
5626 !
5627 ! print results
5628 !
5629
2/2
✓ Branch 0 taken 101 times.
✓ Branch 1 taken 505 times.
606 if(me .eq. 0) then
5630 ! write(6,*) 'summary of qc'
5631 101 permax=0.
5632
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 if(kminl.gt.0) then
5633 per=float(kminl)/float(len)*100.
5634 print 9001,fldlmn,kminl,per
5635 9001 format(' bare land min check. modified to ',f8.1,
5636 & ' at ',i5,' points ',f8.1,'percent')
5637 if(per.gt.permax) permax=per
5638 endif
5639
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 99 times.
101 if(kmaxl.gt.0) then
5640 2 per=float(kmaxl)/float(len)*100.
5641 2 print 9002,fldlmx,kmaxl,per
5642 9002 format(' bare land max check. modified to ',f8.1,
5643 & ' at ',i5,' points ',f4.1,'percent')
5644
1/2
✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
2 if(per.gt.permax) permax=per
5645 endif
5646
2/2
✓ Branch 0 taken 5 times.
✓ Branch 1 taken 96 times.
101 if(kmino.gt.0) then
5647 5 per=float(kmino)/float(len)*100.
5648 5 print 9003,fldomn,kmino,per
5649 9003 format(' open ocean min check. modified to ',f8.1,
5650 & ' at ',i5,' points ',f4.1,'percent')
5651
1/2
✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
5 if(per.gt.permax) permax=per
5652 endif
5653
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 if(kmaxo.gt.0) then
5654 per=float(kmaxo)/float(len)*100.
5655 print 9004,fldomx,kmaxo,per
5656 9004 format(' open sea max check. modified to ',f8.1,
5657 & ' at ',i5,' points ',f4.1,'percent')
5658 if(per.gt.permax) permax=per
5659 endif
5660
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 if(kmins.gt.0) then
5661 per=float(kmins)/float(len)*100.
5662 print 9009,fldsmn,kmins,per
5663 9009 format(' snow covered land min check. modified to ',f8.1,
5664 & ' at ',i5,' points ',f4.1,'percent')
5665 if(per.gt.permax) permax=per
5666 endif
5667
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 if(kmaxs.gt.0) then
5668 per=float(kmaxs)/float(len)*100.
5669 print 9010,fldsmx,kmaxs,per
5670 9010 format(' snow covered land max check. modified to ',f8.1,
5671 & ' at ',i5,' points ',f4.1,'percent')
5672 if(per.gt.permax) permax=per
5673 endif
5674
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 if(kmini.gt.0) then
5675 per=float(kmini)/float(len)*100.
5676 print 9005,fldimn,kmini,per
5677 9005 format(' bare ice min check. modified to ',f8.1,
5678 & ' at ',i5,' points ',f4.1,'percent')
5679 if(per.gt.permax) permax=per
5680 endif
5681
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 if(kmaxi.gt.0) then
5682 per=float(kmaxi)/float(len)*100.
5683 print 9006,fldimx,kmaxi,per
5684 9006 format(' bare ice max check. modified to ',f8.1,
5685 & ' at ',i5,' points ',f4.1,'percent')
5686 if(per.gt.permax) permax=per
5687 endif
5688
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 if(kminj.gt.0) then
5689 per=float(kminj)/float(len)*100.
5690 print 9007,fldjmn,kminj,per
5691 9007 format(' snow covered ice min check. modified to ',f8.1,
5692 & ' at ',i5,' points ',f4.1,'percent')
5693 if(per.gt.permax) permax=per
5694 endif
5695
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 101 times.
101 if(kmaxj.gt.0) then
5696 per=float(kmaxj)/float(len)*100.
5697 print 9008,fldjmx,kmaxj,per
5698 9008 format(' snow covered ice max check. modified to ',f8.1,
5699 & ' at ',i5,' points ',f4.1,'percent')
5700 if(per.gt.permax) permax=per
5701 endif
5702 ! commented on 06/30/99 -- moorthi
5703 ! if(lgchek) then
5704 ! if(permax.gt.percrit) then
5705 ! write(6,*) ' too many bad points. aborting ....'
5706 ! call abort
5707 ! endif
5708 ! endif
5709 !
5710 endif
5711 !
5712 1212 return
5713 end
5714 12 subroutine setzro(fld,eps,len)
5715 !
5716 use machine , only : kind_io8,kind_io4
5717 implicit none
5718 12 integer i,len
5719 real (kind=kind_io8) fld(len),eps
5720
2/2
✓ Branch 0 taken 27648 times.
✓ Branch 1 taken 12 times.
27660 do i=1,len
5721
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
✓ Branch 6 taken 26514 times.
✓ Branch 7 taken 1134 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 26514 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 26514 times.
27660 if(abs(fld(i)).lt.eps) fld(i) = 0.
5722 enddo
5723 12 return
5724 end
5725 6 subroutine getscv(snofld,scvfld,len)
5726 !
5727 use machine , only : kind_io8,kind_io4
5728 implicit none
5729 6 integer i,len
5730 real (kind=kind_io8) snofld(len),scvfld(len)
5731 !
5732
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
5733
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 scvfld(i) = 0.
5734
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 380 times.
✓ Branch 7 taken 13444 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 380 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 380 times.
13830 if(snofld(i).gt.0.) scvfld(i) = 1.
5735 enddo
5736 6 return
5737 end
5738 12 subroutine getstc(tsffld,tg3fld,slifld,len,lsoil,stcfld,tsfimx)
5739 !
5740 use machine , only : kind_io8,kind_io4
5741 implicit none
5742 12 integer k,i,len,lsoil
5743 12 real (kind=kind_io8) factor,tsfimx
5744 real (kind=kind_io8) tsffld(len), tg3fld(len), slifld(len)
5745 real (kind=kind_io8) stcfld(len,lsoil)
5746 !
5747 ! layer soil temperature
5748 !
5749
2/2
✓ Branch 0 taken 48 times.
✓ Branch 1 taken 12 times.
60 do k = 1, lsoil
5750
2/2
✓ Branch 0 taken 110592 times.
✓ Branch 1 taken 48 times.
110652 do i = 1, len
5751
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 110592 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 110592 times.
✓ Branch 6 taken 32120 times.
✓ Branch 7 taken 78472 times.
110640 if(slifld(i).eq.1.0) then
5752 32120 factor = ((k-1) * 2 + 1) / (2. * lsoil)
5753
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 32120 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 32120 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 32120 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 32120 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 32120 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 32120 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 32120 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 32120 times.
32120 stcfld(i,k) = factor*tg3fld(i)+(1.-factor)*tsffld(i)
5754
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 78472 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 78472 times.
✓ Branch 6 taken 4992 times.
✓ Branch 7 taken 73480 times.
78472 elseif(slifld(i).eq.2.0) then
5755 4992 factor = ((k-1) * 2 + 1) / (2. * lsoil)
5756
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 4992 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4992 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4992 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4992 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4992 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4992 times.
4992 stcfld(i,k) = factor*tsfimx+(1.-factor)*tsffld(i)
5757 else
5758
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 73480 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 73480 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 73480 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 73480 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 73480 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 73480 times.
73480 stcfld(i,k) = tg3fld(i)
5759 endif
5760 enddo
5761 enddo
5762
1/2
✓ Branch 0 taken 12 times.
✗ Branch 1 not taken.
12 if(lsoil.gt.2) then
5763
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 12 times.
36 do k = 3, lsoil
5764
2/2
✓ Branch 0 taken 55296 times.
✓ Branch 1 taken 24 times.
55332 do i = 1, len
5765
7/14
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 55296 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 55296 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 55296 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 55296 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 55296 times.
55320 stcfld(i,k) = stcfld(i,2)
5766 enddo
5767 enddo
5768 endif
5769 12 return
5770 end
5771 subroutine getsmc(wetfld,len,lsoil,smcfld,me)
5772 !
5773 use machine , only : kind_io8,kind_io4
5774 implicit none
5775 integer k,i,len,lsoil,me
5776 real (kind=kind_io8) wetfld(len), smcfld(len,lsoil)
5777 !
5778 if (me .eq. 0) write(6,*) 'getsmc'
5779 !
5780 ! layer soil wetness
5781 !
5782 do k = 1, lsoil
5783 do i = 1, len
5784 smcfld(i,k) = (wetfld(i)*1000./150.)*.37 + .1
5785 enddo
5786 enddo
5787 return
5788 end
5789 subroutine usesgt(sig1t,slianl,tg3anl,len,lsoil,tsfanl,stcanl,
5790 & tsfimx)
5791 !
5792 use machine , only : kind_io8,kind_io4
5793 implicit none
5794 integer i,len,lsoil
5795 real (kind=kind_io8) tsfimx
5796 real (kind=kind_io8) sig1t(len), slianl(len), tg3anl(len)
5797 real (kind=kind_io8) tsfanl(len), stcanl(len,lsoil)
5798 !
5799 ! soil temperature
5800 !
5801 if(sig1t(1).gt.0.) then
5802 do i=1,len
5803 if(slianl(i).ne.0.) then
5804 tsfanl(i) = sig1t(i)
5805 endif
5806 enddo
5807 endif
5808 call getstc(tsfanl,tg3anl,slianl,len,lsoil,stcanl,tsfimx)
5809 !
5810 return
5811 end
5812 18 subroutine snosfc(snoanl,tsfanl,tsfsmx,len,me)
5813 use machine , only : kind_io8,kind_io4
5814 implicit none
5815 18 integer kount,i,len,me
5816 18 real (kind=kind_io8) per,tsfsmx
5817 real (kind=kind_io8) snoanl(len), tsfanl(len)
5818 !
5819
2/2
✓ Branch 0 taken 3 times.
✓ Branch 1 taken 15 times.
18 if (me .eq. 0) write(6,*) 'set snow temp to tsfsmx if greater'
5820 18 kount=0
5821
2/2
✓ Branch 0 taken 41472 times.
✓ Branch 1 taken 18 times.
41490 do i=1,len
5822
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 41472 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 41472 times.
✓ Branch 6 taken 2135 times.
✓ Branch 7 taken 39337 times.
41490 if(snoanl(i).gt.0.) then
5823
3/10
✗ Branch 0 not taken.
✓ Branch 1 taken 2135 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 2135 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 2135 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
2135 if(tsfanl(i).gt.tsfsmx) tsfanl(i)=tsfsmx
5824 2135 kount = kount + 1
5825 endif
5826 enddo
5827
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 6 times.
18 if(kount.gt.0) then
5828
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 11 times.
12 if(me .eq. 0) then
5829 1 per=float(kount)/float(len)*100.
5830 1 write(6,*) 'snow sfc. tsf set to ',tsfsmx,' at ',
5831 2 & kount, ' points ',per,'percent'
5832 endif
5833 endif
5834 18 return
5835 end
5836 18 subroutine albocn(albclm,slmask,albomx,len)
5837 use machine , only : kind_io8,kind_io4
5838 implicit none
5839 18 integer i,len
5840 real (kind=kind_io8) albomx
5841 real (kind=kind_io8) albclm(len,4), slmask(len)
5842
2/2
✓ Branch 0 taken 41472 times.
✓ Branch 1 taken 18 times.
41490 do i=1,len
5843
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 41472 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 41472 times.
✓ Branch 6 taken 29427 times.
✓ Branch 7 taken 12045 times.
41490 if(slmask(i).eq.0) then
5844
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 29427 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 29427 times.
29427 albclm(i,1) = albomx
5845
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 29427 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 29427 times.
29427 albclm(i,2) = albomx
5846
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 29427 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 29427 times.
29427 albclm(i,3) = albomx
5847
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 29427 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 29427 times.
29427 albclm(i,4) = albomx
5848 endif
5849 enddo
5850 18 return
5851 end
5852 6 subroutine qcmxice(glacir,amxice,len,me)
5853 use machine , only : kind_io8,kind_io4
5854 implicit none
5855 6 integer i,kount,len,me
5856 6 real (kind=kind_io8) glacir(len),amxice(len),per
5857
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) write(6,*) 'qc of maximum ice extent'
5858 6 kount=0
5859
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
5860
8/12
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✓ Branch 12 taken 308 times.
✓ Branch 13 taken 13516 times.
✓ Branch 14 taken 287 times.
✓ Branch 15 taken 21 times.
13830 if(glacir(i).eq.1..and.amxice(i).eq.0.) then
5861
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 287 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 287 times.
287 amxice(i) = 0.
5862 287 kount = kount + 1
5863 endif
5864 enddo
5865
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 4 times.
6 if(kount.gt.0) then
5866 2 per = float(kount) / float(len)*100.
5867
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
2 if(me .eq. 0) write(6,*) ' max ice limit less than glacier'
5868 &, ' coverage at ', kount, ' points ',per,'percent'
5869 endif
5870 6 return
5871 end
5872 6 subroutine qcsli(slianl,slifcs,len,me)
5873 use machine , only : kind_io8,kind_io4
5874 implicit none
5875 6 integer i,kount,len,me
5876 6 real (kind=kind_io8) slianl(len), slifcs(len),per
5877
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) then
5878 1 write(6,*) ' '
5879 1 write(6,*) 'qcsli'
5880 endif
5881 6 kount=0
5882
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
5883
7/12
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✓ Branch 12 taken 4015 times.
✓ Branch 13 taken 9809 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 4015 times.
13824 if(slianl(i).eq.1..and.slifcs(i).eq.0.) then
5884 kount = kount + 1
5885 slifcs(i) = 1.
5886 endif
5887
7/12
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✓ Branch 12 taken 9185 times.
✓ Branch 13 taken 4639 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 9185 times.
13824 if(slianl(i).eq.0..and.slifcs(i).eq.1.) then
5888 kount = kount + 1
5889 slifcs(i) = 0.
5890 endif
5891
7/12
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✓ Branch 12 taken 624 times.
✓ Branch 13 taken 13200 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 624 times.
13824 if(slianl(i).eq.2..and.slifcs(i).eq.1.) then
5892 kount = kount + 1
5893 slifcs(i) = 0.
5894 endif
5895
7/12
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✓ Branch 12 taken 4015 times.
✓ Branch 13 taken 9809 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 4015 times.
13830 if(slianl(i).eq.1..and.slifcs(i).eq.2.) then
5896 kount = kount + 1
5897 slifcs(i) = 1.
5898 endif
5899 enddo
5900
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(kount.gt.0) then
5901 per=float(kount)/float(len)*100.
5902 if(me .eq. 0) then
5903 write(6,*) ' inconsistency of slmask between forecast and',
5904 & ' analysis corrected at ',kount, ' points ',per,
5905 & 'percent'
5906 endif
5907 endif
5908 6 return
5909 end
5910 ! subroutine nntprt(data,imax,fact)
5911 ! real (kind=kind_io8) data(imax)
5912 ! ilast=0
5913 ! i1=1
5914 ! i2=80
5915 !1112 continue
5916 ! if(i2.ge.imax) then
5917 ! ilast=1
5918 ! i2=imax
5919 ! endif
5920 ! write(6,*) ' '
5921 ! do j=1,jmax
5922 ! write(6,1111) (nint(data(imax*(j-1)+i)*fact),i=i1,i2)
5923 ! enddo
5924 ! if(ilast.eq.1) return
5925 ! i1=i1+80
5926 ! i2=i1+79
5927 ! if(i2.ge.imax) then
5928 ! ilast=1
5929 ! i2=imax
5930 ! endif
5931 ! go to 1112
5932 !1111 format(80i1)
5933 ! return
5934 ! end
5935 18 subroutine qcbyfc(tsffcs,snofcs,qctsfs,qcsnos,qctsfi,
5936 12 & len,lsoil,snoanl,aisanl,slianl,tsfanl,albanl,
5937 & zoranl,smcanl,
5938 & smcclm,tsfsmx,albomx,zoromx, me)
5939 !
5940 use machine , only : kind_io8,kind_io4
5941 implicit none
5942 6 integer kount,me,k,i,lsoil,len
5943 6 real (kind=kind_io8) zoromx,per,albomx,qctsfi,qcsnos,qctsfs,tsfsmx
5944 real (kind=kind_io8) tsffcs(len), snofcs(len)
5945 real (kind=kind_io8) snoanl(len), aisanl(len),
5946 & slianl(len), zoranl(len),
5947 & tsfanl(len), albanl(len,4),
5948 & smcanl(len,lsoil)
5949 real (kind=kind_io8) smcclm(len,lsoil)
5950 !
5951
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) write(6,*) 'qc of snow and sea-ice analysis'
5952 !
5953 ! qc of snow analysis
5954 !
5955 ! questionable snow cover
5956 !
5957 6 kount = 0
5958
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
5959
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 if(slianl(i).gt.0..and.
5960
8/10
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 4639 times.
✓ Branch 7 taken 9185 times.
✓ Branch 8 taken 2051 times.
✓ Branch 9 taken 2588 times.
✓ Branch 10 taken 3 times.
✓ Branch 11 taken 2048 times.
13830 & tsffcs(i).gt.qctsfs.and.snoanl(i).gt.0.) then
5961 3 kount = kount + 1
5962
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 3 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 3 times.
3 snoanl(i) = 0.
5963
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 3 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 3 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 3 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 3 times.
3 tsfanl(i) = tsffcs(i)
5964 endif
5965 enddo
5966
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if(kount.gt.0) then
5967 1 per=float(kount)/float(len)*100.
5968
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 if (me .eq. 0) then
5969 write(6,*) ' guess surface temp .gt. ',qctsfs,
5970 & ' but snow analysis indicates snow cover'
5971 write(6,*) ' snow analysis set to zero',
5972 & ' at ',kount, ' points ',per,'percent'
5973 endif
5974 endif
5975 !
5976 ! questionable no snow cover
5977 !
5978 6 kount = 0
5979
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
5980
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13824 if(slianl(i).gt.0..and.
5981
7/10
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 4639 times.
✓ Branch 7 taken 9185 times.
✓ Branch 8 taken 326 times.
✓ Branch 9 taken 4313 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 326 times.
13830 & snofcs(i).gt.qcsnos.and.snoanl(i).lt.0.) then
5982 kount = kount + 1
5983 snoanl(i) = snofcs(i)
5984 tsfanl(i) = tsffcs(i)
5985 endif
5986 enddo
5987
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(kount.gt.0) then
5988 per=float(kount)/float(len)*100.
5989 if (me .eq. 0) then
5990 write(6,*) ' guess snow depth .gt. ',qcsnos,
5991 & ' but snow analysis indicates no snow cover'
5992 write(6,*) ' snow analysis set to guess value',
5993 & ' at ',kount, ' points ',per,'percent'
5994 endif
5995 endif
5996 !
5997 ! questionable sea ice cover ! this qc is disable to correct error in
5998 ! surface temparature over observed sea ice points
5999 !
6000 ! kount = 0
6001 ! do i=1,len
6002 ! if(slianl(i).eq.2..and.
6003 ! & tsffcs(i).gt.qctsfi.and.aisanl(i).eq.1.) then
6004 ! kount = kount + 1
6005 ! aisanl(i) = 0.
6006 ! slianl(i) = 0.
6007 ! tsfanl(i) = tsffcs(i)
6008 ! snoanl(i) = 0.
6009 ! zoranl(i) = zoromx
6010 ! albanl(i,1) = albomx
6011 ! albanl(i,2) = albomx
6012 ! albanl(i,3) = albomx
6013 ! albanl(i,4) = albomx
6014 ! do k=1,lsoil
6015 ! smcanl(i,k) = smcclm(i,k)
6016 ! enddo
6017 ! endif
6018 ! enddo
6019 ! if(kount.gt.0) then
6020 ! per=float(kount)/float(len)*100.
6021 ! if (me .eq. 0) then
6022 ! write(6,*) ' guess surface temp .gt. ',qctsfi,
6023 ! & ' but sea-ice analysis indicates sea-ice'
6024 ! write(6,*) ' sea-ice analysis set to zero',
6025 ! & ' at ',kount, ' points ',per,'percent'
6026 ! endif
6027 ! endif
6028 !
6029 6 return
6030 end
6031 408 subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat,
6032 408 & data,imax,jmax,rlnout,rltout,lmask,rslmsk
6033 204 &, gaus,blno, blto, kgds1, kpds4, lbms)
6034 use machine , only : kind_io8,kind_io4
6035 use sfccyc_module
6036 implicit none
6037 204 real (kind=kind_io8) blno,blto,wlon,rnlat,crit,data_max
6038 204 integer i,j,ijmax,jgaul,igaul,kpds5,jmax,imax, kgds1, kspla
6039 integer, intent(in) :: kpds4
6040 logical*1, intent(in) :: lbms(imax,jmax)
6041 real*4 :: dummy(imax,jmax)
6042
6043 real (kind=kind_io8) slmask(igaul,jgaul)
6044 real (kind=kind_io8) data(imax,jmax),rslmsk(imax,jmax)
6045 &, rlnout(imax), rltout(jmax)
6046
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 204 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 204 times.
✓ Branch 9 taken 240432 times.
✓ Branch 10 taken 204 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 204 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 204 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 204 times.
✓ Branch 20 taken 240432 times.
✓ Branch 21 taken 204 times.
816 real (kind=kind_io8) a(jmax), w(jmax), radi, dlat, dlon
6047 logical lmask, gaus
6048 !
6049 ! set the longitude and latitudes for the grib file
6050 !
6051
2/2
✓ Branch 0 taken 114 times.
✓ Branch 1 taken 90 times.
204 if (kgds1 .eq. 4) then ! grib file on gaussian grid
6052 114 kspla=4
6053 114 call splat(kspla, jmax, a, w)
6054 !
6055 114 radi = 180.0 / (4.*atan(1.))
6056
2/2
✓ Branch 0 taken 175104 times.
✓ Branch 1 taken 114 times.
175218 do j=1,jmax
6057
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 175104 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 175104 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 175104 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 175104 times.
175218 rltout(j) = acos(a(j)) * radi
6058 enddo
6059 !
6060
1/2
✓ Branch 0 taken 114 times.
✗ Branch 1 not taken.
114 if (rnlat .gt. 0.0) then
6061
2/2
✓ Branch 0 taken 175104 times.
✓ Branch 1 taken 114 times.
175218 do j=1,jmax
6062
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 175104 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 175104 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 175104 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 175104 times.
175218 rltout(j) = 90. - rltout(j)
6063 enddo
6064 else
6065 do j=1,jmax
6066 rltout(j) = -90. + rltout(j)
6067 enddo
6068 endif
6069
1/2
✓ Branch 0 taken 90 times.
✗ Branch 1 not taken.
90 elseif (kgds1 .eq. 0) then ! grib file on lat/lon grid
6070 90 dlat = -(rnlat+rnlat) / float(jmax-1)
6071
2/2
✓ Branch 0 taken 65328 times.
✓ Branch 1 taken 90 times.
65418 do j=1,jmax
6072
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 65328 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 65328 times.
65418 rltout(j) = rnlat + (j-1) * dlat
6073 enddo
6074 else ! grib file on some other grid
6075 call abort
6076 endif
6077 204 dlon = 360.0 / imax
6078
2/2
✓ Branch 0 taken 480300 times.
✓ Branch 1 taken 204 times.
480504 do i=1,imax
6079
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 480300 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 480300 times.
480504 rlnout(i) = wlon + (i-1)*dlon
6080 enddo
6081 !
6082 !
6083 204 ijmax = imax*jmax
6084
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 204 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 204 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 204 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 204 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 204 times.
✓ Branch 18 taken 240432 times.
✓ Branch 19 taken 204 times.
✓ Branch 20 taken 729293376 times.
✓ Branch 21 taken 240432 times.
204 rslmsk = 0.
6085 ! TG3 MODS BEGIN
6086 if(kpds5 == kpdtsf .and. imax == 138 .and. jmax == 116
6087
6/8
✓ Branch 0 taken 18 times.
✓ Branch 1 taken 186 times.
✓ Branch 2 taken 6 times.
✓ Branch 3 taken 12 times.
✓ Branch 4 taken 6 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 6 times.
✗ Branch 7 not taken.
204 & .and. kpds4 == 128) then
6088 ! print*,'turn off setrmsk for tg3'
6089 6 lmask = .false.
6090
6091
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 186 times.
198 elseif(kpds5 == kpdtsf) then
6092 ! TG3 MODS END
6093 !
6094 ! surface temperature
6095 !
6096 12 lmask = .false.
6097 call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat
6098 12 &, rlnout, rltout, gaus, blno, blto)
6099 ! &, dlon, dlat, gaus, blno, blto)
6100 12 crit = 0.5
6101 12 call rof01(rslmsk,ijmax,'ge',crit)
6102 12 lmask = .true.
6103 !
6104 ! bucket soil wetness
6105 !
6106
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 186 times.
186 elseif(kpds5.eq.kpdwet) then
6107 call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat
6108 &, rlnout, rltout, gaus, blno, blto)
6109 ! &, dlon, dlat, gaus, blno, blto)
6110 crit = 0.5
6111 call rof01(rslmsk,ijmax,'ge',crit)
6112 lmask = .true.
6113 ! write(6,*) 'wet rslmsk'
6114 ! znnt=1.
6115 ! call nntprt(rslmsk,ijmax,znnt)
6116 !
6117 ! snow depth
6118 !
6119
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 186 times.
186 elseif(kpds5 == kpdsnd) then
6120 if(kpds4 == 192) then ! use the bitmap
6121 rslmsk = 0.
6122 do j = 1, jmax
6123 do i = 1, imax
6124 if (lbms(i,j)) then
6125 rslmsk(i,j) = 1.
6126 end if
6127 enddo
6128 enddo
6129 lmask=.true.
6130 else
6131 lmask=.false.
6132 end if
6133 !
6134 ! snow liq equivalent depth
6135 !
6136
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 174 times.
186 elseif(kpds5.eq.kpdsno) then
6137 call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat
6138 12 &, rlnout, rltout, gaus, blno, blto)
6139 ! &, dlon, dlat, gaus, blno, blto)
6140 12 crit=0.5
6141 12 call rof01(rslmsk,ijmax,'ge',crit)
6142 12 lmask=.true.
6143 ! write(6,*) 'sno rslmsk'
6144 ! znnt=1.
6145 ! call nntprt(rslmsk,ijmax,znnt)
6146 !
6147 ! soil moisture
6148 !
6149
2/2
✓ Branch 0 taken 48 times.
✓ Branch 1 taken 126 times.
174 elseif(kpds5.eq.kpdsmc) then
6150
1/2
✓ Branch 0 taken 48 times.
✗ Branch 1 not taken.
48 if(kpds4 == 192) then ! use the bitmap
6151
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 48 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 48 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 48 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 48 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 48 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 48 times.
✓ Branch 18 taken 73728 times.
✓ Branch 19 taken 48 times.
✓ Branch 20 taken 226492416 times.
✓ Branch 21 taken 73728 times.
48 rslmsk = 0.
6152
2/2
✓ Branch 0 taken 73728 times.
✓ Branch 1 taken 48 times.
73776 do j = 1, jmax
6153
2/2
✓ Branch 0 taken 226492416 times.
✓ Branch 1 taken 73728 times.
226566192 do i = 1, imax
6154
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 226492416 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 226492416 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 226492416 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 226492416 times.
✓ Branch 12 taken 51626160 times.
✓ Branch 13 taken 174866256 times.
226566144 if (lbms(i,j)) then
6155
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 51626160 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 51626160 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 51626160 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 51626160 times.
51626160 rslmsk(i,j) = 1.
6156 end if
6157 enddo
6158 enddo
6159 48 lmask=.true.
6160 else
6161 call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat
6162 &, rlnout, rltout, gaus, blno, blto)
6163 crit=0.5
6164 call rof01(rslmsk,ijmax,'ge',crit)
6165 lmask=.true.
6166 endif
6167 !
6168 ! surface roughness
6169 !
6170
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 126 times.
126 elseif(kpds5.eq.kpdzor) then
6171 do j=1,jmax
6172 do i=1,imax
6173 rslmsk(i,j)=data(i,j)
6174 enddo
6175 enddo
6176 crit=9.9
6177 call rof01(rslmsk,ijmax,'lt',crit)
6178 lmask=.true.
6179 ! write(6,*) 'zor rslmsk'
6180 ! znnt=1.
6181 ! call nntprt(rslmsk,ijmax,znnt)
6182 !
6183 ! albedo
6184 !
6185 ! elseif(kpds5.eq.kpdalb) then
6186 ! do j=1,jmax
6187 ! do i=1,imax
6188 ! rslmsk(i,j)=data(i,j)
6189 ! enddo
6190 ! enddo
6191 ! crit=99.
6192 ! call rof01(rslmsk,ijmax,'lt',crit)
6193 ! lmask=.true.
6194 ! write(6,*) 'alb rslmsk'
6195 ! znnt=1.
6196 ! call nntprt(rslmsk,ijmax,znnt)
6197 !
6198 ! albedo
6199 !
6200 !cbosu new snowfree albedo database has bitmap, use it.
6201
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 114 times.
126 elseif(kpds5.eq.kpdalb(1)) then
6202
1/2
✓ Branch 0 taken 12 times.
✗ Branch 1 not taken.
12 if (kpds4 == 192) then ! use the bitmap
6203
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 12 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 12 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 12 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 12 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 12 times.
✓ Branch 18 taken 18432 times.
✓ Branch 19 taken 12 times.
✓ Branch 20 taken 56623104 times.
✓ Branch 21 taken 18432 times.
12 rslmsk = 0.
6204
2/2
✓ Branch 0 taken 18432 times.
✓ Branch 1 taken 12 times.
18444 do j = 1, jmax
6205
2/2
✓ Branch 0 taken 56623104 times.
✓ Branch 1 taken 18432 times.
56641548 do i = 1, imax
6206
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 56623104 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 56623104 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 56623104 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 56623104 times.
✓ Branch 12 taken 19125360 times.
✓ Branch 13 taken 37497744 times.
56641536 if (lbms(i,j)) then
6207
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 19125360 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 19125360 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 19125360 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 19125360 times.
19125360 rslmsk(i,j) = 1.
6208 end if
6209 enddo
6210 enddo
6211 12 lmask = .true.
6212 else ! no bitmap. old database has no water flag.
6213 lmask=.false.
6214 end if
6215
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 102 times.
114 elseif(kpds5.eq.kpdalb(2)) then
6216 !cbosu
6217
1/2
✓ Branch 0 taken 12 times.
✗ Branch 1 not taken.
12 if (kpds4 == 192) then ! use the bitmap
6218
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 12 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 12 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 12 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 12 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 12 times.
✓ Branch 18 taken 18432 times.
✓ Branch 19 taken 12 times.
✓ Branch 20 taken 56623104 times.
✓ Branch 21 taken 18432 times.
12 rslmsk = 0.
6219
2/2
✓ Branch 0 taken 18432 times.
✓ Branch 1 taken 12 times.
18444 do j = 1, jmax
6220
2/2
✓ Branch 0 taken 56623104 times.
✓ Branch 1 taken 18432 times.
56641548 do i = 1, imax
6221
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 56623104 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 56623104 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 56623104 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 56623104 times.
✓ Branch 12 taken 19125360 times.
✓ Branch 13 taken 37497744 times.
56641536 if (lbms(i,j)) then
6222
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 19125360 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 19125360 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 19125360 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 19125360 times.
19125360 rslmsk(i,j) = 1.
6223 end if
6224 enddo
6225 enddo
6226 12 lmask = .true.
6227 else ! no bitmap. old database has no water flag.
6228 lmask=.false.
6229 end if
6230
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 90 times.
102 elseif(kpds5.eq.kpdalb(3)) then
6231 !cbosu
6232
1/2
✓ Branch 0 taken 12 times.
✗ Branch 1 not taken.
12 if (kpds4 == 192) then ! use the bitmap
6233
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 12 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 12 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 12 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 12 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 12 times.
✓ Branch 18 taken 18432 times.
✓ Branch 19 taken 12 times.
✓ Branch 20 taken 56623104 times.
✓ Branch 21 taken 18432 times.
12 rslmsk = 0.
6234
2/2
✓ Branch 0 taken 18432 times.
✓ Branch 1 taken 12 times.
18444 do j = 1, jmax
6235
2/2
✓ Branch 0 taken 56623104 times.
✓ Branch 1 taken 18432 times.
56641548 do i = 1, imax
6236
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 56623104 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 56623104 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 56623104 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 56623104 times.
✓ Branch 12 taken 19125360 times.
✓ Branch 13 taken 37497744 times.
56641536 if (lbms(i,j)) then
6237
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 19125360 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 19125360 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 19125360 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 19125360 times.
19125360 rslmsk(i,j) = 1.
6238 end if
6239 enddo
6240 enddo
6241 12 lmask = .true.
6242 else ! no bitmap. old database has no water flag.
6243 lmask=.false.
6244 end if
6245
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 78 times.
90 elseif(kpds5.eq.kpdalb(4)) then
6246 !cbosu
6247
1/2
✓ Branch 0 taken 12 times.
✗ Branch 1 not taken.
12 if (kpds4 == 192) then ! use the bitmap
6248
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 12 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 12 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 12 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 12 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 12 times.
✓ Branch 18 taken 18432 times.
✓ Branch 19 taken 12 times.
✓ Branch 20 taken 56623104 times.
✓ Branch 21 taken 18432 times.
12 rslmsk = 0.
6249
2/2
✓ Branch 0 taken 18432 times.
✓ Branch 1 taken 12 times.
18444 do j = 1, jmax
6250
2/2
✓ Branch 0 taken 56623104 times.
✓ Branch 1 taken 18432 times.
56641548 do i = 1, imax
6251
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 56623104 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 56623104 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 56623104 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 56623104 times.
✓ Branch 12 taken 19125360 times.
✓ Branch 13 taken 37497744 times.
56641536 if (lbms(i,j)) then
6252
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 19125360 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 19125360 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 19125360 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 19125360 times.
19125360 rslmsk(i,j) = 1.
6253 end if
6254 enddo
6255 enddo
6256 12 lmask = .true.
6257 else ! no bitmap. old database has no water flag.
6258 lmask=.false.
6259 end if
6260 !
6261 ! vegetation fraction for albedo
6262 !
6263
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 72 times.
78 elseif(kpds5.eq.kpdalf(1)) then
6264 ! rslmsk=data
6265 ! crit=0.
6266 ! call rof01(rslmsk,ijmax,'gt',crit)
6267 ! lmask=.true.
6268 6 lmask=.false.
6269
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 72 times.
72 elseif(kpds5.eq.kpdalf(2)) then
6270 ! rslmsk=data
6271 ! crit=0.
6272 ! call rof01(rslmsk,ijmax,'gt',crit)
6273 ! lmask=.true.
6274 lmask=.false.
6275 !
6276 ! sea ice
6277 !
6278
2/2
✓ Branch 0 taken 18 times.
✓ Branch 1 taken 54 times.
72 elseif(kpds5.eq.kpdais) then
6279 18 lmask=.false.
6280 ! call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat
6281 ! &, dlon, dlat, gaus, blno, blto)
6282 ! crit=0.5
6283 ! call rof01(rslmsk,ijmax,'ge',crit)
6284 !
6285 18 data_max = 0.0
6286
2/2
✓ Branch 0 taken 4866 times.
✓ Branch 1 taken 18 times.
4884 do j=1,jmax
6287
2/2
✓ Branch 0 taken 3208680 times.
✓ Branch 1 taken 4866 times.
3213564 do i=1,imax
6288
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 3208680 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 3208680 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 3208680 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 3208680 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 3208680 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 3208680 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 3208680 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 3208680 times.
3208680 rslmsk(i,j) = data(i,j)
6289
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 3208680 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 3208680 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 3208680 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 3208680 times.
✓ Branch 12 taken 66 times.
✓ Branch 13 taken 3208614 times.
3213546 data_max= max(data_max,data(i,j))
6290 enddo
6291 enddo
6292 18 crit=1.0
6293
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 6 times.
18 if (data_max .gt. crit) then
6294 12 call rof01(rslmsk,ijmax,'gt',crit)
6295 12 lmask=.true.
6296 else
6297 6 lmask=.false.
6298 endif
6299 ! write(6,*) 'acn rslmsk'
6300 ! znnt=1.
6301 ! call nntprt(rslmsk,ijmax,znnt)
6302 !
6303 ! deep soil temperature
6304 !
6305
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 54 times.
54 elseif(kpds5.eq.kpdtg3) then
6306 lmask=.false.
6307 ! call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat
6308 ! &, rlnout, rltout, gaus, blno, blto)
6309 ! &, dlon, dlat, gaus, blno, blto)
6310 ! crit=0.5
6311 ! call rof01(rslmsk,ijmax,'ge',crit)
6312 ! lmask=.true.
6313 !
6314 ! plant resistance
6315 !
6316 ! elseif(kpds5.eq.kpdplr) then
6317 ! call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat
6318 ! &, rlnout, rltout, gaus, blno, blto)
6319 ! &, dlon, dlat, gaus, blno, blto)
6320 ! crit=0.5
6321 ! call rof01(rslmsk,ijmax,'ge',crit)
6322 ! lmask=.true.
6323 !
6324 ! write(6,*) 'plr rslmsk'
6325 ! znnt=1.
6326 ! call nntprt(rslmsk,ijmax,znnt)
6327 !
6328 ! glacier points
6329 !
6330
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 48 times.
54 elseif(kpds5.eq.kpdgla) then
6331 6 lmask=.false.
6332 !
6333 ! max ice extent
6334 !
6335
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 48 times.
48 elseif(kpds5.eq.kpdmxi) then
6336 lmask=.false.
6337 !
6338 ! snow cover
6339 !
6340
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 48 times.
48 elseif(kpds5.eq.kpdscv) then
6341 call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat
6342 &, rlnout, rltout, gaus, blno, blto)
6343 ! &, dlon, dlat, gaus, blno, blto)
6344 crit=0.5
6345 call rof01(rslmsk,ijmax,'ge',crit)
6346 lmask=.true.
6347 ! write(6,*) 'scv rslmsk'
6348 ! znnt=1.
6349 ! call nntprt(rslmsk,ijmax,znnt)
6350 !
6351 ! sea ice concentration
6352 !
6353
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 48 times.
48 elseif(kpds5.eq.kpdacn) then
6354 lmask=.false.
6355 call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat
6356 &, rlnout, rltout, gaus, blno, blto)
6357 ! &, dlon, dlat, gaus, blno, blto)
6358 crit=0.5
6359 call rof01(rslmsk,ijmax,'ge',crit)
6360 lmask=.true.
6361 ! write(6,*) 'acn rslmsk'
6362 ! znnt=1.
6363 ! call nntprt(rslmsk,ijmax,znnt)
6364 !
6365 ! vegetation cover
6366 !
6367
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 36 times.
48 elseif(kpds5.eq.kpdveg) then
6368 !cggg
6369
1/2
✓ Branch 0 taken 12 times.
✗ Branch 1 not taken.
12 if (kpds4 == 192) then ! use the bitmap
6370
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 12 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 12 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 12 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 12 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 12 times.
✓ Branch 18 taken 15000 times.
✓ Branch 19 taken 12 times.
✓ Branch 20 taken 37500000 times.
✓ Branch 21 taken 15000 times.
12 rslmsk = 0.
6371
2/2
✓ Branch 0 taken 15000 times.
✓ Branch 1 taken 12 times.
15012 do j = 1, jmax
6372
2/2
✓ Branch 0 taken 37500000 times.
✓ Branch 1 taken 15000 times.
37515012 do i = 1, imax
6373
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 37500000 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 37500000 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 37500000 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 37500000 times.
✓ Branch 12 taken 12600420 times.
✓ Branch 13 taken 24899580 times.
37515000 if (lbms(i,j)) then
6374
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 12600420 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 12600420 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 12600420 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 12600420 times.
12600420 rslmsk(i,jmax-j+1) = 1. ! need to flip grid in n/s direction
6375 end if
6376 enddo
6377 enddo
6378 12 lmask = .true.
6379 else ! no bitmap, set mask the old way.
6380
6381 call ga2la(slmask,igaul,jgaul,rslmsk,imax,jmax,wlon,rnlat
6382 &, rlnout, rltout, gaus, blno, blto)
6383 crit=0.5
6384 call rof01(rslmsk,ijmax,'ge',crit)
6385 lmask=.true.
6386
6387 end if
6388 !
6389 ! soil type
6390 !
6391
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 30 times.
36 elseif(kpds5.eq.kpdsot) then
6392
6393
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (kpds4 == 192) then ! use the bitmap
6394
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
✓ Branch 18 taken 9216 times.
✓ Branch 19 taken 6 times.
✓ Branch 20 taken 28311552 times.
✓ Branch 21 taken 9216 times.
6 rslmsk = 0.
6395
2/2
✓ Branch 0 taken 9216 times.
✓ Branch 1 taken 6 times.
9222 do j = 1, jmax
6396
2/2
✓ Branch 0 taken 28311552 times.
✓ Branch 1 taken 9216 times.
28320774 do i = 1, imax
6397
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 28311552 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 28311552 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 28311552 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 28311552 times.
✓ Branch 12 taken 9562680 times.
✓ Branch 13 taken 18748872 times.
28320768 if (lbms(i,j)) then
6398
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 9562680 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9562680 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9562680 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9562680 times.
9562680 rslmsk(i,j) = 1.
6399 end if
6400 enddo
6401 enddo
6402 ! soil type is zero over water, use this to get a bitmap.
6403 else
6404 do j = 1, jmax
6405 do i = 1, imax
6406 rslmsk(i,j) = data(i,j)
6407 enddo
6408 enddo
6409 crit=0.1
6410 call rof01(rslmsk,ijmax,'gt',crit)
6411 endif
6412 6 lmask=.true.
6413 !
6414 ! vegetation type
6415 !
6416
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 24 times.
30 elseif(kpds5.eq.kpdvet) then
6417
6418
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (kpds4 == 192) then ! use the bitmap
6419
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
✓ Branch 18 taken 9216 times.
✓ Branch 19 taken 6 times.
✓ Branch 20 taken 28311552 times.
✓ Branch 21 taken 9216 times.
6 rslmsk = 0.
6420
2/2
✓ Branch 0 taken 9216 times.
✓ Branch 1 taken 6 times.
9222 do j = 1, jmax
6421
2/2
✓ Branch 0 taken 28311552 times.
✓ Branch 1 taken 9216 times.
28320774 do i = 1, imax
6422
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 28311552 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 28311552 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 28311552 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 28311552 times.
✓ Branch 12 taken 9562680 times.
✓ Branch 13 taken 18748872 times.
28320768 if (lbms(i,j)) then
6423
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 9562680 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9562680 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9562680 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9562680 times.
9562680 rslmsk(i,j) = 1.
6424 end if
6425 enddo
6426 enddo
6427 ! veg type is zero over water, use this to get a bitmap.
6428 else
6429 do j = 1, jmax
6430 do i = 1, imax
6431 rslmsk(i,j) = data(i,j)
6432 enddo
6433 enddo
6434 crit=0.1
6435 call rof01(rslmsk,ijmax,'gt',crit)
6436 endif
6437 6 lmask=.true.
6438 !
6439 ! these are for four new data type added by clu -- not sure its correct!
6440 !
6441
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 12 times.
24 elseif(kpds5.eq.kpdvmn) then
6442 !
6443 !cggg greenness is zero over water, use this to get a bitmap.
6444 !
6445
2/2
✓ Branch 0 taken 15000 times.
✓ Branch 1 taken 12 times.
15012 do j = 1, jmax
6446
2/2
✓ Branch 0 taken 37500000 times.
✓ Branch 1 taken 15000 times.
37515012 do i = 1, imax
6447
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 37500000 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 37500000 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 37500000 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 37500000 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 37500000 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 37500000 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 37500000 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 37500000 times.
37515000 rslmsk(i,j) = data(i,j)
6448 enddo
6449 enddo
6450 !
6451 12 crit=0.1
6452 12 call rof01(rslmsk,ijmax,'gt',crit)
6453 12 lmask=.true.
6454 !cggg lmask=.false.
6455 !
6456
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
12 elseif(kpds5.eq.kpdvmx) then
6457 !
6458 !cggg greenness is zero over water, use this to get a bitmap.
6459 !
6460 do j = 1, jmax
6461 do i = 1, imax
6462 rslmsk(i,j) = data(i,j)
6463 enddo
6464 enddo
6465 !
6466 crit=0.1
6467 call rof01(rslmsk,ijmax,'gt',crit)
6468 lmask=.true.
6469 !cggg lmask=.false.
6470 !
6471
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
12 elseif(kpds5.eq.kpdslp) then
6472 !
6473 !cggg slope type is zero over water, use this to get a bitmap.
6474 !
6475
2/2
✓ Branch 0 taken 1080 times.
✓ Branch 1 taken 6 times.
1086 do j = 1, jmax
6476
2/2
✓ Branch 0 taken 388800 times.
✓ Branch 1 taken 1080 times.
389886 do i = 1, imax
6477
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 388800 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 388800 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 388800 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 388800 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 388800 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 388800 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 388800 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 388800 times.
389880 rslmsk(i,j) = data(i,j)
6478 enddo
6479 enddo
6480 !
6481 6 crit=0.1
6482 6 call rof01(rslmsk,ijmax,'gt',crit)
6483 6 lmask=.true.
6484 !cggg lmask=.false.
6485 !
6486 !cbosu new maximum snow albedo database has bitmap
6487
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 elseif(kpds5.eq.kpdabs) then
6488
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (kpds4 == 192) then ! use the bitmap
6489
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
✓ Branch 18 taken 9216 times.
✓ Branch 19 taken 6 times.
✓ Branch 20 taken 28311552 times.
✓ Branch 21 taken 9216 times.
6 rslmsk = 0.
6490
2/2
✓ Branch 0 taken 9216 times.
✓ Branch 1 taken 6 times.
9222 do j = 1, jmax
6491
2/2
✓ Branch 0 taken 28311552 times.
✓ Branch 1 taken 9216 times.
28320774 do i = 1, imax
6492
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 28311552 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 28311552 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 28311552 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 28311552 times.
✓ Branch 12 taken 9562680 times.
✓ Branch 13 taken 18748872 times.
28320768 if (lbms(i,j)) then
6493
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 9562680 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 9562680 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 9562680 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 9562680 times.
9562680 rslmsk(i,j) = 1.
6494 end if
6495 enddo
6496 enddo
6497 6 lmask = .true.
6498 else ! no bitmap. old database has zero over water
6499 do j = 1, jmax
6500 do i = 1, imax
6501 rslmsk(i,j) = data(i,j)
6502 enddo
6503 enddo
6504 crit=0.1
6505 call rof01(rslmsk,ijmax,'gt',crit)
6506 lmask=.true.
6507 end if
6508 endif
6509 !
6510 408 return
6511 end
6512 48 subroutine ga2la(gauin,imxin,jmxin,regout,imxout,jmxout,
6513 24 & wlon,rnlat,rlnout,rltout,gaus,blno, blto)
6514 use machine , only : kind_io8,kind_io4
6515 implicit none
6516 96 integer i1,i2,j2,ishft,i,jj,j1,jtem,jmxout,imxin,jmxin,imxout,
6517 48 & j,iret
6518 96 real (kind=kind_io8) alamd,dxin,aphi,x,sum1,sum2,y,dlati,wlon,
6519 24 & rnlat,dxout,dphi,dlat,facns,tem,blno,
6520 & blto
6521 !
6522 ! interpolation from lat/lon grid to other lat/lon grid
6523 !
6524 real (kind=kind_io8) gauin (imxin,jmxin), regout(imxout,jmxout)
6525 &, rlnout(imxout), rltout(jmxout)
6526 logical gaus
6527 !
6528 real, allocatable :: gaul(:)
6529
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✓ Branch 9 taken 27060 times.
✓ Branch 10 taken 24 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 24 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 24 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 24 times.
✓ Branch 20 taken 54144 times.
✓ Branch 21 taken 24 times.
72 real (kind=kind_io8) ddx(imxout),ddy(jmxout)
6530
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✓ Branch 9 taken 54144 times.
✓ Branch 10 taken 24 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 24 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 24 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 24 times.
✓ Branch 20 taken 54144 times.
✓ Branch 21 taken 24 times.
72 integer iindx1(imxout), iindx2(imxout),
6531
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✓ Branch 9 taken 27060 times.
✓ Branch 10 taken 24 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 24 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 24 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 24 times.
✓ Branch 20 taken 27060 times.
✓ Branch 21 taken 24 times.
72 & jindx1(jmxout), jindx2(jmxout)
6532 48 integer jmxsav,n,kspla
6533 data jmxsav/0/
6534 save jmxsav, gaul, dlati
6535 24 real (kind=kind_io8) radi
6536
10/16
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 24 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 24 times.
✓ Branch 9 taken 8640 times.
✓ Branch 10 taken 24 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 24 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 24 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 24 times.
✓ Branch 20 taken 8640 times.
✓ Branch 21 taken 24 times.
144 real (kind=kind_io8) a(jmxin), w(jmxin)
6537 !
6538 !
6539 logical first
6540 integer num_threads
6541 data first /.true./
6542 save num_threads, first
6543 !
6544 96 integer len_thread_m, j1_t, j2_t, it
6545 integer num_parthds
6546 !
6547
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 18 times.
24 if (first) then
6548 6 num_threads = num_parthds()
6549 6 first = .false.
6550 endif
6551 !
6552
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 18 times.
24 if (jmxin .ne. jmxsav) then
6553
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
6 if (jmxsav .gt. 0) deallocate (gaul, stat=iret)
6554
7/14
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 6 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 6 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
6 allocate (gaul(jmxin))
6555 6 jmxsav = jmxin
6556
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (gaus) then
6557 cjfe call gaulat(gaul,jmxin)
6558 cjfe
6559 !
6560 kspla=4
6561 call splat(kspla, jmxin, a, w)
6562 !
6563 radi = 180.0 / (4.*atan(1.))
6564 do n=1,jmxin
6565 gaul(n) = acos(a(n)) * radi
6566 enddo
6567 cjfe
6568 do j=1,jmxin
6569 gaul(j) = 90. - gaul(j)
6570 enddo
6571 else
6572 6 dlat = -2*blto / float(jmxin-1)
6573 6 dlati = 1 / dlat
6574
2/2
✓ Branch 0 taken 2160 times.
✓ Branch 1 taken 6 times.
2166 do j=1,jmxin
6575
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 2160 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 2160 times.
2166 gaul(j) = blto + (j-1) * dlat
6576 enddo
6577 endif
6578 endif
6579 !
6580 !
6581 24 dxin = 360. / float(imxin )
6582 !
6583
2/2
✓ Branch 0 taken 54144 times.
✓ Branch 1 taken 24 times.
54168 do i=1,imxout
6584
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 54144 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 54144 times.
54144 alamd = rlnout(i)
6585
2/2
✓ Branch 0 taken 54096 times.
✓ Branch 1 taken 48 times.
54144 i1 = floor((alamd-blno)/dxin) + 1
6586
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 54144 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 54144 times.
54144 ddx(i) = (alamd-blno)/dxin-(i1-1)
6587
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 54144 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 54144 times.
54144 iindx1(i) = modulo(i1-1,imxin) + 1
6588
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 54144 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 54144 times.
54168 iindx2(i) = modulo(i1 ,imxin) + 1
6589 enddo
6590 !
6591 !
6592 24 len_thread_m = (jmxout+num_threads-1) / num_threads
6593 !
6594
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
24 if (gaus) then
6595 !
6596 !$omp parallel do private(j1_t,j2_t,it,j1,j2,jj)
6597 !$omp+private(aphi)
6598 !$omp+shared(num_threads,len_thread_m)
6599 !$omp+shared(jmxin,jmxout,gaul,rltout,jindx1,ddy)
6600 !
6601 do it=1,num_threads ! start of threaded loop ...................
6602 j1_t = (it-1)*len_thread_m+1
6603 j2_t = min(j1_t+len_thread_m-1,jmxout)
6604 !
6605 j2=1
6606 do 40 j=j1_t,j2_t
6607 aphi=rltout(j)
6608 do 50 jj=1,jmxin
6609 if(aphi.lt.gaul(jj)) go to 50
6610 j2=jj
6611 go to 42
6612 50 continue
6613 42 continue
6614 if(j2.gt.2) go to 43
6615 j1=1
6616 j2=2
6617 go to 44
6618 43 continue
6619 if(j2.le.jmxin) go to 45
6620 j1=jmxin-1
6621 j2=jmxin
6622 go to 44
6623 45 continue
6624 j1=j2-1
6625 44 continue
6626 jindx1(j)=j1
6627 jindx2(j)=j2
6628 ddy(j)=(aphi-gaul(j1))/(gaul(j2)-gaul(j1))
6629 40 continue
6630 enddo ! end of threaded loop ...................
6631 !$omp end parallel do
6632 !
6633 else
6634 !$omp parallel do private(j1_t,j2_t,it,j1,j2,jtem)
6635 !$omp+private(aphi)
6636 !$omp+shared(num_threads,len_thread_m)
6637 !$omp+shared(jmxin,jmxout,gaul,rltout,jindx1,ddy,dlati,blto)
6638 !
6639
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 24 times.
48 do it=1,num_threads ! start of threaded loop ...................
6640 24 j1_t = (it-1)*len_thread_m+1
6641
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
24 j2_t = min(j1_t+len_thread_m-1,jmxout)
6642 !
6643 24 j2=1
6644
2/2
✓ Branch 0 taken 27060 times.
✓ Branch 1 taken 24 times.
27108 do 400 j=j1_t,j2_t
6645
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 27060 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27060 times.
27060 aphi=rltout(j)
6646 27060 jtem = (aphi - blto) * dlati + 1
6647
4/4
✓ Branch 0 taken 27024 times.
✓ Branch 1 taken 36 times.
✓ Branch 2 taken 26988 times.
✓ Branch 3 taken 36 times.
27060 if (jtem .ge. 1 .and. jtem .lt. jmxin) then
6648 26988 j1 = jtem
6649 26988 j2 = j1 + 1
6650
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 26988 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 26988 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 26988 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 26988 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 26988 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 26988 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 26988 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 26988 times.
26988 ddy(j)=(aphi-gaul(j1))/(gaul(j2)-gaul(j1))
6651
2/2
✓ Branch 0 taken 36 times.
✓ Branch 1 taken 36 times.
72 elseif (jtem .eq. jmxin) then
6652 36 j1 = jmxin
6653 36 j2 = jmxin
6654
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 36 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 36 times.
36 ddy(j)=1.0
6655 else
6656 36 j1 = 1
6657 36 j2 = 1
6658
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 36 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 36 times.
36 ddy(j)=1.0
6659 endif
6660 !
6661
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 27060 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27060 times.
27060 jindx1(j) = j1
6662
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 27060 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27060 times.
27060 jindx2(j) = j2
6663 24 400 continue
6664 enddo ! end of threaded loop ...................
6665 !$omp end parallel do
6666 endif
6667 !
6668 ! write(6,*) 'ga2la'
6669 ! write(6,*) 'iindx1'
6670 ! write(6,*) (iindx1(n),n=1,imxout)
6671 ! write(6,*) 'iindx2'
6672 ! write(6,*) (iindx2(n),n=1,imxout)
6673 ! write(6,*) 'jindx1'
6674 ! write(6,*) (jindx1(n),n=1,jmxout)
6675 ! write(6,*) 'jindx2'
6676 ! write(6,*) (jindx2(n),n=1,jmxout)
6677 ! write(6,*) 'ddy'
6678 ! write(6,*) (ddy(n),n=1,jmxout)
6679 ! write(6,*) 'ddx'
6680 ! write(6,*) (ddx(n),n=1,jmxout)
6681 !
6682 !
6683 !$omp parallel do private(j1_t,j2_t,it,i,i1,i2)
6684 !$omp+private(j,j1,j2,x,y)
6685 !$omp+shared(num_threads,len_thread_m)
6686 !$omp+shared(imxout,iindx1,jindx1,ddx,ddy,gauin,regout)
6687 !
6688
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 24 times.
48 do it=1,num_threads ! start of threaded loop ...................
6689 24 j1_t = (it-1)*len_thread_m+1
6690
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
24 j2_t = min(j1_t+len_thread_m-1,jmxout)
6691 !
6692
2/2
✓ Branch 0 taken 27060 times.
✓ Branch 1 taken 24 times.
27108 do j=j1_t,j2_t
6693
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 27060 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27060 times.
27060 y = ddy(j)
6694
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 27060 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27060 times.
27060 j1 = jindx1(j)
6695
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 27060 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27060 times.
27060 j2 = jindx2(j)
6696
2/2
✓ Branch 0 taken 112193280 times.
✓ Branch 1 taken 27060 times.
112220364 do i=1,imxout
6697
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 112193280 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 112193280 times.
112193280 x = ddx(i)
6698
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 112193280 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 112193280 times.
112193280 i1 = iindx1(i)
6699
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 112193280 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 112193280 times.
112193280 i2 = iindx2(i)
6700
12/24
✗ Branch 0 not taken.
✓ Branch 1 taken 112193280 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 112193280 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 112193280 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 112193280 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 112193280 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 112193280 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 112193280 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 112193280 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 112193280 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 112193280 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 112193280 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 112193280 times.
112193280 regout(i,j) = (1.-x)*((1.-y)*gauin(i1,j1) + y*gauin(i1,j2))
6701
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 112193280 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 112193280 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 112193280 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 112193280 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 112193280 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 112193280 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 112193280 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 112193280 times.
112220340 & + x *((1.-y)*gauin(i2,j1) + y*gauin(i2,j2))
6702 enddo
6703 enddo
6704 enddo ! end of threaded loop ...................
6705 !$omp end parallel do
6706 !
6707 24 sum1 = 0.
6708 24 sum2 = 0.
6709
2/2
✓ Branch 0 taken 17280 times.
✓ Branch 1 taken 24 times.
17304 do i=1,imxin
6710
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 17280 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 17280 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 17280 times.
17280 sum1 = sum1 + gauin(i,1)
6711
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 17280 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 17280 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 17280 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 17280 times.
17304 sum2 = sum2 + gauin(i,jmxin)
6712 enddo
6713 24 sum1 = sum1 / float(imxin)
6714 24 sum2 = sum2 / float(imxin)
6715 !
6716
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
24 if (gaus) then
6717 if (rnlat .gt. 0.0) then
6718 do i=1,imxout
6719 regout(i, 1) = sum1
6720 regout(i,jmxout) = sum2
6721 enddo
6722 else
6723 do i=1,imxout
6724 regout(i, 1) = sum2
6725 regout(i,jmxout) = sum1
6726 enddo
6727 endif
6728 else
6729
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
24 if (blto .lt. 0.0) then
6730 if (rnlat .gt. 0.0) then
6731 do i=1,imxout
6732 regout(i, 1) = sum2
6733 regout(i,jmxout) = sum1
6734 enddo
6735 else
6736 do i=1,imxout
6737 regout(i, 1) = sum1
6738 regout(i,jmxout) = sum2
6739 enddo
6740 endif
6741 else
6742
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 24 times.
24 if (rnlat .lt. 0.0) then
6743 do i=1,imxout
6744 regout(i, 1) = sum2
6745 regout(i,jmxout) = sum1
6746 enddo
6747 else
6748
2/2
✓ Branch 0 taken 54144 times.
✓ Branch 1 taken 24 times.
54168 do i=1,imxout
6749
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 54144 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 54144 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 54144 times.
54144 regout(i, 1) = sum1
6750
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 54144 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 54144 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 54144 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 54144 times.
54168 regout(i,jmxout) = sum2
6751 enddo
6752 endif
6753 endif
6754 endif
6755 !
6756 48 return
6757 end
6758 6 subroutine landtyp(vegtype,soiltype,slptype,slmask,len)
6759 use machine , only : kind_io8,kind_io4
6760 implicit none
6761 6 integer i,len
6762 real (kind=kind_io8) vegtype(len),soiltype(len),slmask(len)
6763 +, slptype(len)
6764 !
6765 ! make sure that the soil type and veg type are non-zero over land
6766 !
6767
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i = 1, len
6768
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 4015 times.
✓ Branch 7 taken 9809 times.
13830 if (slmask(i) .eq. 1) then
6769
3/10
✗ Branch 0 not taken.
✓ Branch 1 taken 4015 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4015 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4015 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
4015 if (vegtype(i) .eq. 0.) vegtype(i) = 7
6770
3/10
✗ Branch 0 not taken.
✓ Branch 1 taken 4015 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4015 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4015 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
4015 if (soiltype(i) .eq. 0.) soiltype(i) = 2
6771
3/10
✗ Branch 0 not taken.
✓ Branch 1 taken 4015 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4015 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4015 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
4015 if (slptype(i) .eq. 0.) slptype(i) = 1
6772 endif
6773 enddo
6774 6 return
6775 end subroutine landtyp
6776 subroutine gaulat(gaul,k)
6777 !
6778 use machine , only : kind_io8,kind_io4
6779 implicit none
6780 integer n,k
6781 real (kind=kind_io8) radi
6782 real (kind=kind_io8) a(k), w(k), gaul(k)
6783 !
6784 call splat(4, k, a, w)
6785 !
6786 radi = 180.0 / (4.*atan(1.))
6787 do n=1,k
6788 gaul(n) = acos(a(n)) * radi
6789 enddo
6790 !
6791 ! print *,'gaussian lat (deg) for jmax=',k
6792 ! print *,(gaul(n),n=1,k)
6793 !
6794 return
6795 70 write(6,6000)
6796 6000 format(//5x,'error in gauaw'//)
6797 stop
6798 end
6799 !-----------------------------------------------------------------------
6800 subroutine anomint(tsfan0,tsfclm,tsfcl0,tsfanl,len)
6801 !
6802 use machine , only : kind_io8,kind_io4
6803 implicit none
6804 integer i,len
6805 real (kind=kind_io8) tsfanl(len), tsfan0(len),
6806 & tsfclm(len), tsfcl0(len)
6807 !
6808 ! time interpolation of anomalies
6809 ! add initial anomaly to date interpolated climatology
6810 !
6811 write(6,*) 'anomint'
6812 do i=1,len
6813 tsfanl(i) = tsfan0(i) - tsfcl0(i) + tsfclm(i)
6814 enddo
6815 return
6816 end
6817 6 subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,
6818
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
12 & slmask,fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc,
6819
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
6 & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc,
6820
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
6 & fnvetc,fnsotc,
6821
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
6 & fnvmnc,fnvmxc,fnslpc,fnabsc,
6822 12 & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm,aisclm,
6823 12 & tg3clm,cvclm ,cvbclm,cvtclm,
6824 24 & cnpclm,smcclm,stcclm,sliclm,scvclm,acnclm,vegclm,
6825 12 & vetclm,sotclm,alfclm,
6826 6 & vmnclm,vmxclm,slpclm,absclm,
6827 & kpdtsf,kpdwet,kpdsno,kpdzor,kpdalb,kpdais,
6828 & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg,
6829 6 & kpdvet,kpdsot,kpdalf,tsfcl0,
6830 & kpdvmn,kpdvmx,kpdslp,kpdabs,
6831 & deltsfc, lanom
6832 6 &, imsk, jmsk, slmskh, outlat, outlon
6833
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 &, gaus, blno, blto, me,lprnt,iprnt, fnalbc2, ialb
6834 6 &, tile_num_ch, i_index, j_index, sst_perturbation)
6835 !
6836 use machine , only : kind_io8,kind_io4
6837 implicit none
6838 character(len=*), intent(in) :: tile_num_ch
6839 integer, intent(in) :: i_index(len), j_index(len)
6840 24 real (kind=kind_io8) rjday,wei1x,wei2x,rjdayh,wei2m,wei1m,wei1s,
6841 12 & wei2s,fh,stcmon1s,blto,blno,deltsfc,rjdayh2
6842 12 real (kind=kind_io8) wei1y,wei2y
6843 42 integer jdoy,jday,jh,jdow,mmm,mmp,mm,iret,monend,i,k,jm,jd,iy4,
6844 30 & jy,mon1,is2,isx,kpd9,is1,l,nn,mon2,mon,is,kpdsno,
6845 & kpdzor,kpdtsf,kpdwet,kpdscv,kpdacn,kpdais,kpdtg3,im,id,
6846 & lugb,iy,len,lsoil,ih,kpdsmc,iprnt,me,m1,m2,k1,k2,
6847 & kpdvet,kpdsot,kpdstc,kpdveg,jmsk,imsk,j,ialb
6848 &, kpdvmn,kpdvmx,kpdslp,kpdabs,landice_cat
6849 integer kpdalb(4), kpdalf(2)
6850 !
6851 character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc,
6852 & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc,
6853 & fnvetc,fnsotc,fnalbc2
6854 &, fnvmnc,fnvmxc,fnslpc,fnabsc
6855 real (kind=kind_io8) tsfclm(len),tsfcl2(len),
6856 & wetclm(len),snoclm(len),
6857 & zorclm(len),albclm(len,4),aisclm(len),
6858 & tg3clm(len),acnclm(len),
6859 & cvclm (len),cvbclm(len),cvtclm(len),
6860 & cnpclm(len),
6861 & smcclm(len,lsoil),stcclm(len,lsoil),
6862 & sliclm(len),scvclm(len),vegclm(len),
6863 & vetclm(len),sotclm(len),alfclm(len,2)
6864 &, vmnclm(len),vmxclm(len),slpclm(len),absclm(len)
6865 real (kind=kind_io8) slmskh(imsk,jmsk)
6866 real (kind=kind_io8) outlat(len), outlon(len)
6867 !
6868 real (kind=kind_io8) slmask(len), tsfcl0(len)
6869 6 real (kind=kind_io8), allocatable :: slmask_noice(:)
6870 !
6871 logical lanom, gaus, first
6872 !
6873 ! set z0 based on sib vegetation type
6874 real (kind=kind_io8) z0_sib(13)
6875 data z0_sib /2.653, 0.826, 0.563, 1.089, 0.854, 0.856,
6876 & 0.035, 0.238, 0.065, 0.076, 0.011, 0.125,
6877 & 0.011 /
6878 ! set z0 based on igbp vegetation type
6879 real (kind=kind_io8) z0_igbp_min(20), z0_igbp_max(20)
6880
2/2
✓ Branch 0 taken 72 times.
✓ Branch 1 taken 6 times.
6 real (kind=kind_io8) z0_season(12)
6881 data z0_igbp_min /1.089, 2.653, 0.854, 0.826, 0.800, 0.050,
6882 & 0.030, 0.856, 0.856, 0.150, 0.040, 0.130,
6883 & 1.000, 0.250, 0.011, 0.011, 0.001, 0.076,
6884 & 0.050, 0.030/
6885 data z0_igbp_max /1.089, 2.653, 0.854, 0.826, 0.800, 0.050,
6886 & 0.030, 0.856, 0.856, 0.150, 0.040, 0.130,
6887 & 1.000, 0.250, 0.011, 0.011, 0.001, 0.076,
6888 & 0.050, 0.030/
6889 !
6890 ! dayhf : julian day of the middle of each month
6891 !
6892 real (kind=kind_io8) dayhf(13)
6893 data dayhf/ 15.5, 45.0, 74.5,105.0,135.5,166.0,
6894 & 196.5,227.5,258.0,288.5,319.0,349.5,380.5/
6895 !
6896
2/2
✓ Branch 0 taken 30 times.
✓ Branch 1 taken 6 times.
6 real (kind=kind_io8) fha(5)
6897
2/2
✓ Branch 0 taken 30 times.
✓ Branch 1 taken 6 times.
6 real(4) fha4(5)
6898 6 integer w3kindreal,w3kindint
6899
4/4
✓ Branch 0 taken 48 times.
✓ Branch 1 taken 6 times.
✓ Branch 2 taken 48 times.
✓ Branch 3 taken 6 times.
24 integer ida(8),jda(8),ivtyp, kpd7
6900 !
6901 real (kind=kind_io8), allocatable :: tsf(:,:),sno(:,:),
6902 & zor(:,:),wet(:,:),
6903 & ais(:,:), acn(:,:), scv(:,:), smc(:,:,:),
6904 & tg3(:), alb(:,:,:), alf(:,:),
6905 & vet(:), sot(:), tsf2(:),
6906 & veg(:,:), stc(:,:,:)
6907 &, vmn(:), vmx(:), slp(:), absm(:)
6908 !
6909 12 integer mon1s, mon2s, sea1s, sea2s, sea1, sea2, hyr1, hyr2
6910 real(kind=kind_io8) sst_perturbation
6911 data first/.true./
6912 data mon1s/0/, mon2s/0/, sea1s/0/, sea2s/0/
6913 !
6914 save first, tsf, sno, zor, wet, ais, acn, scv, smc, tg3,
6915 & alb, alf, vet, sot, tsf2, veg, stc,
6916 & vmn, vmx, slp, absm,
6917 & mon1s, mon2s, sea1s, sea2s, dayhf, k1, k2, m1, m2,
6918 & landice_cat
6919 !
6920 logical lprnt
6921 !
6922
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
6923
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 tsfclm(i) = 0.0
6924
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 tsfcl2(i) = 0.0
6925
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 snoclm(i) = 0.0
6926
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 wetclm(i) = 0.0
6927
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 zorclm(i) = 0.0
6928
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 aisclm(i) = 0.0
6929
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 tg3clm(i) = 0.0
6930
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 acnclm(i) = 0.0
6931
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 cvclm(i) = 0.0
6932
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 cvbclm(i) = 0.0
6933
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 cvtclm(i) = 0.0
6934
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 cnpclm(i) = 0.0
6935
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 sliclm(i) = 0.0
6936
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 scvclm(i) = 0.0
6937
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 vmnclm(i) = 0.0
6938
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 vmxclm(i) = 0.0
6939
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 slpclm(i) = 0.0
6940
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13830 absclm(i) = 0.0
6941 enddo
6942
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do k=1,lsoil
6943
2/2
✓ Branch 0 taken 55296 times.
✓ Branch 1 taken 24 times.
55326 do i=1,len
6944
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 55296 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 55296 times.
55296 smcclm(i,k) = 0.0
6945
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 55296 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 55296 times.
55320 stcclm(i,k) = 0.0
6946 enddo
6947 enddo
6948
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do k=1,4
6949
2/2
✓ Branch 0 taken 55296 times.
✓ Branch 1 taken 24 times.
55326 do i=1,len
6950
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 55296 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 55296 times.
55320 albclm(i,k) = 0.0
6951 enddo
6952 enddo
6953
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 6 times.
18 do k=1,2
6954
2/2
✓ Branch 0 taken 27648 times.
✓ Branch 1 taken 12 times.
27666 do i=1,len
6955
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 27648 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 27648 times.
27660 alfclm(i,k) = 0.0
6956 enddo
6957 enddo
6958 !
6959 6 iret = 0
6960 6 monend = 9999
6961 !
6962
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (first) then
6963 !
6964 ! allocate variables to be saved
6965 !
6966 allocate (tsf(len,2), sno(len,2), zor(len,2),
6967 & wet(len,2), ais(len,2), acn(len,2),
6968 & scv(len,2), smc(len,lsoil,2),
6969 & tg3(len), alb(len,4,2), alf(len,2),
6970 & vet(len), sot(len), tsf2(len),
6971 !clu [+1l] add vmn, vmx, slp, abs
6972 & vmn(len), vmx(len), slp(len), absm(len),
6973
157/314
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 6 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 6 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 6 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
✓ Branch 18 taken 6 times.
✗ Branch 19 not taken.
✗ Branch 20 not taken.
✓ Branch 21 taken 6 times.
✗ Branch 22 not taken.
✓ Branch 23 taken 6 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 6 times.
✗ Branch 26 not taken.
✓ Branch 27 taken 6 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 6 times.
✗ Branch 31 not taken.
✓ Branch 32 taken 6 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 6 times.
✓ Branch 36 taken 6 times.
✗ Branch 37 not taken.
✗ Branch 38 not taken.
✓ Branch 39 taken 6 times.
✗ Branch 40 not taken.
✓ Branch 41 taken 6 times.
✗ Branch 42 not taken.
✓ Branch 43 taken 6 times.
✗ Branch 44 not taken.
✓ Branch 45 taken 6 times.
✗ Branch 46 not taken.
✓ Branch 47 taken 6 times.
✗ Branch 49 not taken.
✓ Branch 50 taken 6 times.
✗ Branch 51 not taken.
✓ Branch 52 taken 6 times.
✓ Branch 54 taken 6 times.
✗ Branch 55 not taken.
✗ Branch 56 not taken.
✓ Branch 57 taken 6 times.
✗ Branch 58 not taken.
✓ Branch 59 taken 6 times.
✗ Branch 60 not taken.
✓ Branch 61 taken 6 times.
✗ Branch 62 not taken.
✓ Branch 63 taken 6 times.
✗ Branch 64 not taken.
✓ Branch 65 taken 6 times.
✗ Branch 67 not taken.
✓ Branch 68 taken 6 times.
✗ Branch 69 not taken.
✓ Branch 70 taken 6 times.
✓ Branch 72 taken 6 times.
✗ Branch 73 not taken.
✗ Branch 74 not taken.
✓ Branch 75 taken 6 times.
✗ Branch 76 not taken.
✓ Branch 77 taken 6 times.
✗ Branch 78 not taken.
✓ Branch 79 taken 6 times.
✗ Branch 80 not taken.
✓ Branch 81 taken 6 times.
✗ Branch 82 not taken.
✓ Branch 83 taken 6 times.
✗ Branch 85 not taken.
✓ Branch 86 taken 6 times.
✗ Branch 87 not taken.
✓ Branch 88 taken 6 times.
✓ Branch 90 taken 6 times.
✗ Branch 91 not taken.
✗ Branch 92 not taken.
✓ Branch 93 taken 6 times.
✗ Branch 94 not taken.
✓ Branch 95 taken 6 times.
✗ Branch 96 not taken.
✓ Branch 97 taken 6 times.
✗ Branch 98 not taken.
✓ Branch 99 taken 6 times.
✗ Branch 100 not taken.
✓ Branch 101 taken 6 times.
✗ Branch 103 not taken.
✓ Branch 104 taken 6 times.
✗ Branch 105 not taken.
✓ Branch 106 taken 6 times.
✓ Branch 108 taken 6 times.
✗ Branch 109 not taken.
✗ Branch 110 not taken.
✓ Branch 111 taken 6 times.
✗ Branch 112 not taken.
✓ Branch 113 taken 6 times.
✗ Branch 114 not taken.
✓ Branch 115 taken 6 times.
✗ Branch 116 not taken.
✓ Branch 117 taken 6 times.
✗ Branch 118 not taken.
✓ Branch 119 taken 6 times.
✗ Branch 121 not taken.
✓ Branch 122 taken 6 times.
✗ Branch 123 not taken.
✓ Branch 124 taken 6 times.
✓ Branch 126 taken 6 times.
✗ Branch 127 not taken.
✗ Branch 128 not taken.
✓ Branch 129 taken 6 times.
✓ Branch 130 taken 6 times.
✗ Branch 131 not taken.
✗ Branch 132 not taken.
✓ Branch 133 taken 6 times.
✗ Branch 134 not taken.
✓ Branch 135 taken 6 times.
✗ Branch 136 not taken.
✓ Branch 137 taken 6 times.
✗ Branch 138 not taken.
✓ Branch 139 taken 6 times.
✗ Branch 140 not taken.
✓ Branch 141 taken 6 times.
✗ Branch 143 not taken.
✓ Branch 144 taken 6 times.
✗ Branch 145 not taken.
✓ Branch 146 taken 6 times.
✓ Branch 148 taken 6 times.
✗ Branch 149 not taken.
✗ Branch 150 not taken.
✓ Branch 151 taken 6 times.
✗ Branch 152 not taken.
✓ Branch 153 taken 6 times.
✗ Branch 154 not taken.
✓ Branch 155 taken 6 times.
✗ Branch 156 not taken.
✓ Branch 157 taken 6 times.
✗ Branch 159 not taken.
✓ Branch 160 taken 6 times.
✗ Branch 161 not taken.
✓ Branch 162 taken 6 times.
✓ Branch 164 taken 6 times.
✗ Branch 165 not taken.
✗ Branch 166 not taken.
✓ Branch 167 taken 6 times.
✗ Branch 168 not taken.
✓ Branch 169 taken 6 times.
✗ Branch 170 not taken.
✓ Branch 171 taken 6 times.
✗ Branch 172 not taken.
✓ Branch 173 taken 6 times.
✗ Branch 174 not taken.
✓ Branch 175 taken 6 times.
✗ Branch 176 not taken.
✓ Branch 177 taken 6 times.
✗ Branch 179 not taken.
✓ Branch 180 taken 6 times.
✗ Branch 181 not taken.
✓ Branch 182 taken 6 times.
✓ Branch 184 taken 6 times.
✗ Branch 185 not taken.
✗ Branch 186 not taken.
✓ Branch 187 taken 6 times.
✗ Branch 188 not taken.
✓ Branch 189 taken 6 times.
✗ Branch 190 not taken.
✓ Branch 191 taken 6 times.
✗ Branch 192 not taken.
✓ Branch 193 taken 6 times.
✗ Branch 194 not taken.
✓ Branch 195 taken 6 times.
✗ Branch 197 not taken.
✓ Branch 198 taken 6 times.
✗ Branch 199 not taken.
✓ Branch 200 taken 6 times.
✓ Branch 202 taken 6 times.
✗ Branch 203 not taken.
✗ Branch 204 not taken.
✓ Branch 205 taken 6 times.
✗ Branch 206 not taken.
✓ Branch 207 taken 6 times.
✗ Branch 208 not taken.
✓ Branch 209 taken 6 times.
✗ Branch 210 not taken.
✓ Branch 211 taken 6 times.
✗ Branch 213 not taken.
✓ Branch 214 taken 6 times.
✗ Branch 215 not taken.
✓ Branch 216 taken 6 times.
✓ Branch 218 taken 6 times.
✗ Branch 219 not taken.
✗ Branch 220 not taken.
✓ Branch 221 taken 6 times.
✗ Branch 222 not taken.
✓ Branch 223 taken 6 times.
✗ Branch 224 not taken.
✓ Branch 225 taken 6 times.
✗ Branch 226 not taken.
✓ Branch 227 taken 6 times.
✗ Branch 229 not taken.
✓ Branch 230 taken 6 times.
✗ Branch 231 not taken.
✓ Branch 232 taken 6 times.
✓ Branch 234 taken 6 times.
✗ Branch 235 not taken.
✗ Branch 236 not taken.
✓ Branch 237 taken 6 times.
✗ Branch 238 not taken.
✓ Branch 239 taken 6 times.
✗ Branch 240 not taken.
✓ Branch 241 taken 6 times.
✗ Branch 242 not taken.
✓ Branch 243 taken 6 times.
✗ Branch 245 not taken.
✓ Branch 246 taken 6 times.
✗ Branch 247 not taken.
✓ Branch 248 taken 6 times.
✓ Branch 250 taken 6 times.
✗ Branch 251 not taken.
✗ Branch 252 not taken.
✓ Branch 253 taken 6 times.
✗ Branch 254 not taken.
✓ Branch 255 taken 6 times.
✗ Branch 256 not taken.
✓ Branch 257 taken 6 times.
✗ Branch 258 not taken.
✓ Branch 259 taken 6 times.
✗ Branch 261 not taken.
✓ Branch 262 taken 6 times.
✗ Branch 263 not taken.
✓ Branch 264 taken 6 times.
✓ Branch 266 taken 6 times.
✗ Branch 267 not taken.
✗ Branch 268 not taken.
✓ Branch 269 taken 6 times.
✗ Branch 270 not taken.
✓ Branch 271 taken 6 times.
✗ Branch 272 not taken.
✓ Branch 273 taken 6 times.
✗ Branch 274 not taken.
✓ Branch 275 taken 6 times.
✗ Branch 277 not taken.
✓ Branch 278 taken 6 times.
✗ Branch 279 not taken.
✓ Branch 280 taken 6 times.
✓ Branch 282 taken 6 times.
✗ Branch 283 not taken.
✗ Branch 284 not taken.
✓ Branch 285 taken 6 times.
✗ Branch 286 not taken.
✓ Branch 287 taken 6 times.
✗ Branch 288 not taken.
✓ Branch 289 taken 6 times.
✗ Branch 290 not taken.
✓ Branch 291 taken 6 times.
✗ Branch 293 not taken.
✓ Branch 294 taken 6 times.
✗ Branch 295 not taken.
✓ Branch 296 taken 6 times.
✓ Branch 298 taken 6 times.
✗ Branch 299 not taken.
✗ Branch 300 not taken.
✓ Branch 301 taken 6 times.
✗ Branch 302 not taken.
✓ Branch 303 taken 6 times.
✗ Branch 304 not taken.
✓ Branch 305 taken 6 times.
✗ Branch 306 not taken.
✓ Branch 307 taken 6 times.
✗ Branch 309 not taken.
✓ Branch 310 taken 6 times.
✗ Branch 311 not taken.
✓ Branch 312 taken 6 times.
✓ Branch 314 taken 6 times.
✗ Branch 315 not taken.
✗ Branch 316 not taken.
✓ Branch 317 taken 6 times.
✗ Branch 318 not taken.
✓ Branch 319 taken 6 times.
✗ Branch 320 not taken.
✓ Branch 321 taken 6 times.
✗ Branch 322 not taken.
✓ Branch 323 taken 6 times.
✗ Branch 324 not taken.
✓ Branch 325 taken 6 times.
✗ Branch 327 not taken.
✓ Branch 328 taken 6 times.
✗ Branch 330 not taken.
✓ Branch 331 taken 6 times.
✓ Branch 333 taken 6 times.
✗ Branch 334 not taken.
✗ Branch 335 not taken.
✓ Branch 336 taken 6 times.
✓ Branch 337 taken 6 times.
✗ Branch 338 not taken.
✗ Branch 339 not taken.
✓ Branch 340 taken 6 times.
✗ Branch 341 not taken.
✓ Branch 342 taken 6 times.
✗ Branch 343 not taken.
✓ Branch 344 taken 6 times.
✗ Branch 345 not taken.
✓ Branch 346 taken 6 times.
✗ Branch 347 not taken.
✓ Branch 348 taken 6 times.
✗ Branch 350 not taken.
✓ Branch 351 taken 6 times.
✗ Branch 353 not taken.
✓ Branch 354 taken 6 times.
114 & veg(len,2), stc(len,lsoil,2))
6974 !
6975 ! get tsf climatology for the begining of the forecast
6976 !
6977
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (fh > 0.0) then
6978 !cbosu
6979 if (me == 0) print*,'bosu fh gt 0'
6980
6981 iy4 = iy
6982 if (iy < 101) iy4 = 1900 + iy4
6983 fha = 0
6984 ida = 0
6985 jda = 0
6986 ! fha(2) = nint(fh)
6987 ida(1) = iy
6988 ida(2) = im
6989 ida(3) = id
6990 ida(5) = ih
6991 call w3kind(w3kindreal,w3kindint)
6992 if(w3kindreal == 4) then
6993 fha4 = fha
6994 call w3movdat(fha4,ida,jda)
6995 else
6996 call w3movdat(fha,ida,jda)
6997 endif
6998 jy = jda(1)
6999 jm = jda(2)
7000 jd = jda(3)
7001 jh = jda(5)
7002 if (me == 0) write(6,*) ' forecast jy,jm,jd,jh',
7003 & jy,jm,jd,jh
7004 jdow = 0
7005 jdoy = 0
7006 jday = 0
7007 call w3doxdat(jda,jdow,jdoy,jday)
7008 rjday = jdoy + jda(5) / 24.
7009 if(rjday < dayhf(1)) rjday = rjday + 365.
7010 !
7011 if (me == 0) write(6,*) 'forecast jy,jm,jd,jh=',jy,jm,jd,jh
7012 !
7013 ! for monthly mean climatology
7014 !
7015 monend = 12
7016 do mm=1,monend
7017 mmm = mm
7018 mmp = mm + 1
7019 if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp)) then
7020 mon1 = mmm
7021 mon2 = mmp
7022 go to 10
7023 endif
7024 enddo
7025 print *,'wrong rjday',rjday
7026 call abort
7027 10 continue
7028 wei1m = (dayhf(mon2)-rjday)/(dayhf(mon2)-dayhf(mon1))
7029 wei2m = 1.0 - wei1m
7030 ! wei2m = (rjday-dayhf(mon1))/(dayhf(mon2)-dayhf(mon1))
7031 if (mon2 == 13) mon2 = 1
7032 if (me == 0) print *,'rjday,mon1,mon2,wei1m,wei2m=',
7033 & rjday,mon1,mon2,wei1m,wei2m
7034 !
7035 ! read monthly mean climatology of tsf
7036 !
7037 kpd7 = -1
7038 do nn=1,2
7039 mon = mon1
7040 if (nn == 2) mon = mon2
7041 call fixrdc(lugb,fntsfc,kpdtsf,kpd7,mon,slmask,
7042 & tsf(1,nn),len,iret
7043 &, imsk, jmsk, slmskh, gaus,blno, blto
7044 &, outlat, outlon, me)
7045 tsf(:,nn) = tsf(:,nn) + sst_perturbation
7046 enddo
7047 !
7048 ! tsf at the begining of forecast i.e. fh=0
7049 !
7050 do i=1,len
7051 tsfcl0(i) = wei1m * tsf(i,1) + wei2m * tsf(i,2)
7052 enddo
7053 endif
7054 endif
7055 !
7056 ! compute current jy,jm,jd,jh of forecast and the day of the year
7057 !
7058 6 iy4 = iy
7059
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (iy < 101) iy4=1900+iy4
7060 6 fha = 0
7061 6 ida = 0
7062 6 jda = 0
7063 6 fha(2) = nint(fh)
7064 6 ida(1) = iy
7065 6 ida(2) = im
7066 6 ida(3) = id
7067 6 ida(5) = ih
7068 6 call w3kind(w3kindreal,w3kindint)
7069
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(w3kindreal == 4) then
7070 fha4 = fha
7071 call w3movdat(fha4,ida,jda)
7072 else
7073 6 call w3movdat(fha,ida,jda)
7074 endif
7075 6 jy = jda(1)
7076 6 jm = jda(2)
7077 6 jd = jda(3)
7078 6 jh = jda(5)
7079 ! if (me .eq. 0) write(6,*) ' forecast jy,jm,jd,jh,rjday=',
7080 ! & jy,jm,jd,jh,rjday
7081 6 jdow = 0
7082 6 jdoy = 0
7083 6 jday = 0
7084 6 call w3doxdat(jda,jdow,jdoy,jday)
7085 6 rjday = jdoy + jda(5) / 24.
7086
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(rjday < dayhf(1)) rjday = rjday + 365.
7087
7088
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
7 if (me == 0) write(6,*) ' forecast jy,jm,jd,jh,rjday=',
7089 2 & jy,jm,jd,jh,rjday
7090 !
7091
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me == 0) write(6,*) 'forecast jy,jm,jd,jh=',jy,jm,jd,jh
7092 !
7093 ! for monthly mean climatology
7094 !
7095 6 monend = 12
7096
1/2
✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
42 do mm=1,monend
7097 42 mmm = mm
7098 42 mmp = mm + 1
7099
7/12
✗ Branch 0 not taken.
✓ Branch 1 taken 42 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 42 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 42 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 42 times.
✓ Branch 12 taken 42 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 6 times.
✓ Branch 15 taken 36 times.
42 if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp)) then
7100 6 mon1 = mmm
7101 6 mon2 = mmp
7102 6 go to 20
7103 endif
7104 enddo
7105 print *,'wrong rjday',rjday
7106 call abort
7107 20 continue
7108
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
6 wei1m = (dayhf(mon2)-rjday)/(dayhf(mon2)-dayhf(mon1))
7109 6 wei2m = 1.0 - wei1m
7110 ! wei2m = (rjday-dayhf(mon1))/(dayhf(mon2)-dayhf(mon1))
7111
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (mon2 == 13) mon2 = 1
7112
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
7 if (me == 0) print *,'rjday,mon1,mon2,wei1m,wei2m=',
7113 2 & rjday,mon1,mon2,wei1m,wei2m
7114 !
7115 ! for seasonal mean climatology
7116 !
7117 6 monend = 4
7118 6 is = im/3 + 1
7119
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (is == 5) is = 1
7120
1/2
✓ Branch 0 taken 18 times.
✗ Branch 1 not taken.
18 do mm=1,monend
7121 18 mmm = mm*3 - 2
7122 18 mmp = (mm+1)*3 - 2
7123
7/12
✗ Branch 0 not taken.
✓ Branch 1 taken 18 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 18 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 18 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 18 times.
✓ Branch 12 taken 18 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 6 times.
✓ Branch 15 taken 12 times.
18 if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp)) then
7124 6 sea1 = mmm
7125 6 sea2 = mmp
7126 6 go to 30
7127 endif
7128 enddo
7129 print *,'wrong rjday',rjday
7130 call abort
7131 30 continue
7132
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
6 wei1s = (dayhf(sea2)-rjday)/(dayhf(sea2)-dayhf(sea1))
7133 6 wei2s = 1.0 - wei1s
7134 ! wei2s = (rjday-dayhf(sea1))/(dayhf(sea2)-dayhf(sea1))
7135
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (sea2 == 13) sea2 = 1
7136
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
7 if (me == 0) print *,'rjday,sea1,sea2,wei1s,wei2s=',
7137 2 & rjday,sea1,sea2,wei1s,wei2s
7138 !
7139 ! for summer and winter values (maximum and minimum).
7140 !
7141 6 monend = 2
7142 6 is = im/6 + 1
7143
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (is == 3) is = 1
7144
1/2
✓ Branch 0 taken 12 times.
✗ Branch 1 not taken.
12 do mm=1,monend
7145 12 mmm = mm*6 - 5
7146 12 mmp = (mm+1)*6 - 5
7147
7/12
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 12 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 12 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 12 times.
✓ Branch 12 taken 12 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 6 times.
✓ Branch 15 taken 6 times.
12 if(rjday >= dayhf(mmm) .and. rjday < dayhf(mmp)) then
7148 6 hyr1 = mmm
7149 6 hyr2 = mmp
7150 6 go to 31
7151 endif
7152 enddo
7153 print *,'wrong rjday',rjday
7154 call abort
7155 31 continue
7156
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
6 wei1y = (dayhf(hyr2)-rjday)/(dayhf(hyr2)-dayhf(hyr1))
7157 6 wei2y = 1.0 - wei1y
7158 ! wei2y = (rjday-dayhf(hyr1))/(dayhf(hyr2)-dayhf(hyr1))
7159
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (hyr2 == 13) hyr2 = 1
7160
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
7 if (me == 0) print *,'rjday,hyr1,hyr2,wei1y,wei2y=',
7161 2 & rjday,hyr1,hyr2,wei1y,wei2y
7162 !
7163 ! start reading in climatology and interpolate to the date
7164 !
7165
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 first_time : if (first) then
7166 !cbosu
7167
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me == 0) print*,'bosu first time thru'
7168 !
7169 ! annual mean climatology
7170 !
7171 ! fraction of vegetation field for albedo -- there are two
7172 ! fraction fields in this version: strong zenith angle dependent
7173 ! and weak zenith angle dependent
7174 !
7175 6 kpd9 = -1
7176 cjfe
7177
4/4
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 6 times.
✓ Branch 2 taken 27648 times.
✓ Branch 3 taken 12 times.
6 alf=0.
7178 cjfe
7179
7180 6 kpd7=-1
7181
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (ialb == 1) then
7182 !cbosu still need facsf and facwf. read them from the production
7183 !cbosu file
7184
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if ( index(fnalbc2, "tileX.nc") == 0) then ! grib file
7185 call fixrdc(lugb,fnalbc2,kpdalf(1),kpd7,kpd9,slmask
7186 &, alf,len,iret
7187 &, imsk, jmsk, slmskh, gaus,blno, blto
7188 6 &, outlat, outlon, me)
7189 else
7190 call fixrdc_tile(fnalbc2, tile_num_ch, i_index, j_index,
7191 & kpdalf(1), alf(:,1), 1, len, me)
7192 endif
7193 else
7194 call fixrdc(lugb,fnalbc,kpdalf(1),kpd7,kpd9,slmask
7195 &, alf,len,iret
7196 &, imsk, jmsk, slmskh, gaus,blno, blto
7197 &, outlat, outlon, me)
7198 endif
7199
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i = 1, len
7200
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✓ Branch 6 taken 4015 times.
✓ Branch 7 taken 9809 times.
13830 if(slmask(i).eq.1.) then
7201
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 4015 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4015 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 4015 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 4015 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 4015 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 4015 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 4015 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 4015 times.
4015 alf(i,2) = 100. - alf(i,1)
7202 endif
7203 enddo
7204 !
7205 ! deep soil temperature
7206 !
7207
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fntg3c(1:8).ne.' ') then
7208
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if ( index(fntg3c, "tileX.nc") == 0) then ! grib file
7209 6 kpd7=-1
7210 call fixrdc(lugb,fntg3c,kpdtg3,kpd7,kpd9,slmask,
7211 & tg3,len,iret
7212 &, imsk, jmsk, slmskh, gaus,blno, blto
7213 6 &, outlat, outlon, me)
7214 else
7215 call fixrdc_tile(fntg3c, tile_num_ch, i_index, j_index,
7216 & kpdtg3, tg3, 1, len, me)
7217 endif
7218 endif
7219 !
7220 ! vegetation type
7221 !
7222 ! when using the new gldas soil moisture climatology, a veg type
7223 ! dataset must be selected.
7224 !
7225
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnvetc(1:8).ne.' ') then
7226
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if ( index(fnvetc, "tileX.nc") == 0) then ! grib file
7227 6 kpd7=-1
7228 call fixrdc(lugb,fnvetc,kpdvet,kpd7,kpd9,slmask,
7229 & vet,len,iret
7230 &, imsk, jmsk, slmskh, gaus,blno, blto
7231 6 &, outlat, outlon, me)
7232 6 landice_cat=13
7233
11/20
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✓ Branch 12 taken 6 times.
✗ Branch 13 not taken.
✗ Branch 14 not taken.
✓ Branch 15 taken 6 times.
✗ Branch 16 not taken.
✗ Branch 17 not taken.
✓ Branch 18 taken 13824 times.
✓ Branch 19 taken 6 times.
✓ Branch 20 taken 29 times.
✓ Branch 21 taken 13795 times.
✓ Branch 22 taken 6 times.
✗ Branch 23 not taken.
6 if (maxval(vet)> 13.0) landice_cat=15
7234 else
7235 call fixrdc_tile(fnvetc, tile_num_ch, i_index, j_index,
7236 & kpdvet, vet, 1, len, me)
7237 landice_cat=15
7238 endif
7239
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
7 if (me .eq. 0) write(6,*) 'climatological vegetation',
7240 2 & ' type read in.'
7241 elseif(index(fnsmcc,'soilmgldas') /= 0) then ! new soil moisture climo
7242 if (me .eq. 0) write(6,*) 'fatal error: must choose'
7243 if (me .eq. 0) write(6,*) 'climatological veg type when'
7244 if (me .eq. 0) write(6,*) 'using new gldas soil moisture.'
7245 call abort
7246 endif
7247 !
7248 ! soil type
7249 !
7250
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnsotc(1:8).ne.' ') then
7251
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if ( index(fnsotc, "tileX.nc") == 0) then ! grib file
7252 6 kpd7=-1
7253 call fixrdc(lugb,fnsotc,kpdsot,kpd7,kpd9,slmask,
7254 & sot,len,iret
7255 &, imsk, jmsk, slmskh, gaus,blno, blto
7256 6 &, outlat, outlon, me)
7257 else
7258 call fixrdc_tile(fnsotc, tile_num_ch, i_index, j_index,
7259 & kpdsot, sot, 1, len, me)
7260 endif
7261
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) write(6,*) 'climatological soil type read in.'
7262 endif
7263
7264 !
7265 ! min vegetation cover
7266 !
7267
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnvmnc(1:8).ne.' ') then
7268
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if ( index(fnvmnc, "tileX.nc") == 0) then ! grib file
7269 6 kpd7=-1
7270 call fixrdc(lugb,fnvmnc,kpdvmn,kpd7,kpd9,slmask,
7271 & vmn,len,iret
7272 &, imsk, jmsk, slmskh, gaus,blno, blto
7273 6 &, outlat, outlon, me)
7274 else
7275 call fixrdc_tile(fnvmnc, tile_num_ch, i_index, j_index,
7276 & 257, vmn, 99, len, me)
7277
7278 endif
7279
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) write(6,*) 'climatological shdmin read in.'
7280 endif
7281 !
7282 ! max vegetation cover
7283 !
7284
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnvmxc(1:8).ne.' ') then
7285
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if ( index(fnvmxc, "tileX.nc") == 0) then ! grib file
7286 6 kpd7=-1
7287 call fixrdc(lugb,fnvmxc,kpdvmx,kpd7,kpd9,slmask,
7288 & vmx,len,iret
7289 &, imsk, jmsk, slmskh, gaus,blno, blto
7290 6 &, outlat, outlon, me)
7291 else
7292 call fixrdc_tile(fnvmxc, tile_num_ch, i_index, j_index,
7293 & 256, vmx, 99, len, me)
7294 endif
7295
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) write(6,*) 'climatological shdmax read in.'
7296 endif
7297 !
7298 ! slope type
7299 !
7300
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnslpc(1:8).ne.' ') then
7301
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if ( index(fnslpc, "tileX.nc") == 0) then ! grib file
7302 6 kpd7=-1
7303 call fixrdc(lugb,fnslpc,kpdslp,kpd7,kpd9,slmask,
7304 & slp,len,iret
7305 &, imsk, jmsk, slmskh, gaus,blno, blto
7306 6 &, outlat, outlon, me)
7307 else
7308 call fixrdc_tile(fnslpc, tile_num_ch, i_index, j_index,
7309 & kpdslp, slp, 1, len, me)
7310 endif
7311
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) write(6,*) 'climatological slope read in.'
7312 endif
7313 !
7314 ! max snow albeod
7315 !
7316
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnabsc(1:8).ne.' ') then
7317
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if ( index(fnabsc, "tileX.nc") == 0) then ! grib file
7318 6 kpd7=-1
7319 call fixrdc(lugb,fnabsc,kpdabs,kpd7,kpd9,slmask,
7320 & absm,len,iret
7321 &, imsk, jmsk, slmskh, gaus,blno, blto
7322 6 &, outlat, outlon, me)
7323 else
7324 call fixrdc_tile(fnabsc, tile_num_ch, i_index, j_index,
7325 & kpdabs, absm, 1, len, me)
7326 endif
7327
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
6 if (me .eq. 0) write(6,*) 'climatological snoalb read in.'
7328 endif
7329 !clu ----------------------------------------------------------------------
7330 !
7331 6 is1 = sea1/3 + 1
7332 6 is2 = sea2/3 + 1
7333
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (is1 .eq. 5) is1 = 1
7334
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (is2 .eq. 5) is2 = 1
7335
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 6 times.
18 do nn=1,2
7336 !
7337 ! seasonal mean climatology
7338
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
12 if(nn.eq.1) then
7339 6 isx=is1
7340 else
7341 6 isx=is2
7342 endif
7343
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
12 if(isx.eq.1) kpd9 = 12
7344
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
12 if(isx.eq.2) kpd9 = 3
7345
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
12 if(isx.eq.3) kpd9 = 6
7346
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
12 if(isx.eq.4) kpd9 = 9
7347 !
7348 ! seasonal mean climatology
7349 !
7350 ! albedo
7351 ! there are four albedo fields in this version:
7352 ! two for strong zeneith angle dependent (visible and near ir)
7353 ! and two for weak zeneith angle dependent (vis ans nir)
7354 !
7355
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
12 if (ialb == 0) then
7356 kpd7=-1
7357 do k = 1, 4
7358 call fixrdc(lugb,fnalbc,kpdalb(k),kpd7,kpd9,slmask,
7359 & alb(1,k,nn),len,iret
7360 &, imsk, jmsk, slmskh, gaus,blno, blto
7361 &, outlat, outlon, me)
7362 enddo
7363 endif
7364 !
7365 ! monthly mean climatology
7366 !
7367 12 mon = mon1
7368
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 6 times.
12 if (nn .eq. 2) mon = mon2
7369 !cbosu
7370 !cbosu new snowfree albedo database is monthly.
7371
1/2
✓ Branch 0 taken 12 times.
✗ Branch 1 not taken.
12 if (ialb == 1) then
7372
1/2
✓ Branch 0 taken 12 times.
✗ Branch 1 not taken.
12 if ( index(fnalbc, "tileX.nc") == 0) then ! grib file
7373 12 kpd7=-1
7374
2/2
✓ Branch 0 taken 48 times.
✓ Branch 1 taken 12 times.
60 do k = 1, 4
7375
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 48 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 48 times.
48 call fixrdc(lugb,fnalbc,kpdalb(k),kpd7,mon,slmask,
7376
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 48 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 48 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 48 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 48 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 48 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 48 times.
336 & alb(1,k,nn),len,iret
7377 &, imsk, jmsk, slmskh, gaus,blno, blto
7378 348 &, outlat, outlon, me)
7379 enddo
7380 else
7381 do k = 1, 4
7382 call fixrdc_tile(fnalbc, tile_num_ch, i_index, j_index,
7383 & kpdalb(k), alb(:,k,nn), mon, len, me)
7384 enddo
7385 endif
7386 endif
7387
7388 ! if(lprnt) print *,' mon1=',mon1,' mon2=',mon2
7389 !
7390 ! tsf at the current time t
7391 !
7392 12 kpd7=-1
7393 call fixrdc(lugb,fntsfc,kpdtsf,kpd7,mon,slmask,
7394
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 12 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 12 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 12 times.
60 & tsf(1,nn),len,iret
7395 &, imsk, jmsk, slmskh, gaus,blno, blto
7396 60 &, outlat, outlon, me)
7397
15/28
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 12 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 12 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 12 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 12 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 12 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 12 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 12 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 12 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 12 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 12 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 12 times.
✗ Branch 36 not taken.
✓ Branch 37 taken 12 times.
✓ Branch 39 taken 27648 times.
✓ Branch 40 taken 12 times.
12 tsf(:,nn) = tsf(:,nn) + sst_perturbation
7398 ! if(lprnt) print *,' tsf=',tsf(iprnt,nn),' nn=',nn
7399 !
7400 ! tsf...at time t-deltsfc
7401 !
7402 ! fh2 = fh - deltsfc
7403 ! if (fh2 .gt. 0.0) then
7404 ! call fixrd(lugb,fntsfc,kpdtsf,lclim,slmask,
7405 ! & iy,im,id,ih,fh2,tsfcl2,len,iret
7406 ! &, imsk, jmsk, slmskh, gaus,blno, blto
7407 ! &, outlat, outlon, me)
7408 ! else
7409 ! do i=1,len
7410 ! tsfcl2(i) = tsfclm(i)
7411 ! enddo
7412 ! endif
7413 !
7414 ! soil wetness
7415 !
7416
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
12 if(fnwetc(1:8).ne.' ') then
7417 kpd7=-1
7418 call fixrdc(lugb,fnwetc,kpdwet,kpd7,mon,slmask,
7419 & wet(1,nn),len,iret
7420 &, imsk, jmsk, slmskh, gaus,blno, blto
7421 &, outlat, outlon, me)
7422
1/2
✓ Branch 0 taken 12 times.
✗ Branch 1 not taken.
12 elseif(fnsmcc(1:8).ne.' ') then
7423
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
12 if (index(fnsmcc,'global_soilmcpc.1x1.grb') /= 0) then ! the old climo data
7424 kpd7=-1
7425 call fixrdc(lugb,fnsmcc,kpdsmc,kpd7,mon,slmask,
7426 & smc(1,lsoil,nn),len,iret
7427 &, imsk, jmsk, slmskh, gaus,blno, blto
7428 &, outlat, outlon, me)
7429 do l=1,lsoil-1
7430 do i = 1, len
7431 smc(i,l,nn) = smc(i,lsoil,nn)
7432 enddo
7433 enddo
7434 else ! the new gldas data. it does not have data defined at landice
7435 ! points. so for efficiency, don't have fixrdc try to
7436 ! find a value at landice points as defined by the vet type (vet).
7437
7/14
✓ Branch 0 taken 12 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 12 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 12 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 12 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 12 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 12 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 12 times.
12 allocate(slmask_noice(len))
7438
2/2
✓ Branch 0 taken 27648 times.
✓ Branch 1 taken 12 times.
12 slmask_noice=1.0
7439
2/2
✓ Branch 0 taken 27648 times.
✓ Branch 1 taken 12 times.
27660 do i = 1, len
7440
6/8
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
✓ Branch 6 taken 8030 times.
✓ Branch 7 taken 19618 times.
✓ Branch 8 taken 638 times.
✓ Branch 9 taken 7392 times.
110592 if (nint(vet(i)) < 1 .or.
7441
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
82956 & nint(vet(i)) == landice_cat) then
7442
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 20256 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 20256 times.
20256 slmask_noice(i) = 0.0
7443 endif
7444 enddo
7445
2/2
✓ Branch 0 taken 48 times.
✓ Branch 1 taken 12 times.
60 do k = 1, lsoil
7446
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 36 times.
48 if (k==1) kpd7=10 ! 0_10 cm (pds octs 11 and 12)
7447
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 36 times.
48 if (k==2) kpd7=2600 ! 10_40 cm
7448
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 36 times.
48 if (k==3) kpd7=10340 ! 40_100 cm
7449
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 36 times.
48 if (k==4) kpd7=25800 ! 100_200 cm
7450 call fixrdc(lugb,fnsmcc,kpdsmc,kpd7,mon,slmask_noice,
7451
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 48 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 48 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 48 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 48 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 48 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 48 times.
336 & smc(1,k,nn),len,iret
7452 &, imsk, jmsk, slmskh, gaus,blno, blto
7453 348 &, outlat, outlon, me)
7454 enddo
7455
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
12 deallocate(slmask_noice)
7456 endif
7457 else
7458 write(6,*) 'climatological soil wetness file not given'
7459 call abort
7460 endif
7461 !
7462 ! soil temperature
7463 !
7464
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
12 if(fnstcc(1:8).ne.' ') then
7465 kpd7=-1
7466 call fixrdc(lugb,fnstcc,kpdstc,kpd7,mon,slmask,
7467 & stc(1,lsoil,nn),len,iret
7468 &, imsk, jmsk, slmskh, gaus,blno, blto
7469 &, outlat, outlon, me)
7470 do l=1,lsoil-1
7471 do i = 1, len
7472 stc(i,l,nn) = stc(i,lsoil,nn)
7473 enddo
7474 enddo
7475 endif
7476 !
7477 ! sea ice
7478 !
7479 12 kpd7=-1
7480
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
12 if(fnacnc(1:8).ne.' ') then
7481 call fixrdc(lugb,fnacnc,kpdacn,kpd7,mon,slmask,
7482 & acn(1,nn),len,iret
7483 &, imsk, jmsk, slmskh, gaus,blno, blto
7484 &, outlat, outlon, me)
7485
1/2
✓ Branch 0 taken 12 times.
✗ Branch 1 not taken.
24 elseif(fnaisc(1:8).ne.' ') then
7486 call fixrdc(lugb,fnaisc,kpdais,kpd7,mon,slmask,
7487
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 12 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 12 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 12 times.
60 & ais(1,nn),len,iret
7488 &, imsk, jmsk, slmskh, gaus,blno, blto
7489 60 &, outlat, outlon, me)
7490 else
7491 write(6,*) 'climatological ice cover file not given'
7492 call abort
7493 endif
7494 !
7495 ! snow depth
7496 !
7497 12 kpd7=-1
7498 call fixrdc(lugb,fnsnoc,kpdsno,kpd7,mon,slmask,
7499
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 12 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 12 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 12 times.
60 & sno(1,nn),len,iret
7500 &, imsk, jmsk, slmskh, gaus,blno, blto
7501 60 &, outlat, outlon, me)
7502 !
7503 ! snow cover
7504 !
7505
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
12 if(fnscvc(1:8).ne.' ') then
7506 kpd7=-1
7507 call fixrdc(lugb,fnscvc,kpdscv,kpd7,mon,slmask,
7508 & scv(1,nn),len,iret
7509 &, imsk, jmsk, slmskh, gaus,blno, blto
7510 &, outlat, outlon, me)
7511 write(6,*) 'climatological snow cover read in.'
7512 endif
7513 !
7514 ! surface roughness
7515 !
7516
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
12 if(fnzorc(1:3) == 'sib') then
7517 if (me == 0) then
7518 write(6,*) 'roughness length to be set from sib veg type'
7519 endif
7520
1/2
✓ Branch 0 taken 12 times.
✗ Branch 1 not taken.
12 elseif(fnzorc(1:4) == 'igbp') then
7521
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 10 times.
12 if (me == 0) then
7522 2 write(6,*) 'roughness length to be set from igbp veg type'
7523 endif
7524 else
7525 kpd7=-1
7526 call fixrdc(lugb,fnzorc,kpdzor,kpd7,mon,slmask,
7527 & zor(1,nn),len,iret
7528 &, imsk, jmsk, slmskh, gaus,blno, blto
7529 &, outlat, outlon, me)
7530 endif
7531 !
7532
2/2
✓ Branch 0 taken 27648 times.
✓ Branch 1 taken 12 times.
27660 do i = 1, len
7533 ! set clouds climatology to zero
7534
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
27648 cvclm (i) = 0.
7535
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
27648 cvbclm(i) = 0.
7536
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
27648 cvtclm(i) = 0.
7537 !
7538
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
27660 cnpclm(i) = 0. !set canopy water content climatology to zero
7539 enddo
7540 !
7541 ! vegetation cover
7542 !
7543
1/2
✓ Branch 2 taken 12 times.
✗ Branch 3 not taken.
42 if(fnvegc(1:8).ne.' ') then
7544
1/2
✓ Branch 0 taken 12 times.
✗ Branch 1 not taken.
24 if ( index(fnvegc, "tileX.nc") == 0) then ! grib file
7545 12 kpd7=-1
7546 call fixrdc(lugb,fnvegc,kpdveg,kpd7,mon,slmask,
7547
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 12 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 12 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 12 times.
60 & veg(1,nn),len,iret
7548 &, imsk, jmsk, slmskh, gaus,blno, blto
7549 60 &, outlat, outlon, me)
7550 else
7551 call fixrdc_tile(fnvegc, tile_num_ch, i_index, j_index,
7552 & kpdveg, veg(:,nn), mon, len, me)
7553 endif
7554
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 10 times.
14 if (me .eq. 0) write(6,*) 'climatological vegetation',
7555 4 & ' cover read in for mon=',mon
7556 endif
7557
7558 enddo
7559 !
7560 6 mon1s = mon1 ; mon2s = mon2 ; sea1s = sea1 ; sea2s = sea2
7561 !
7562
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
7 if (me == 0) print *,' mon1s=',mon1s,' mon2s=',mon2s
7563 2 &,' sea1s=',sea1s,' sea2s=',sea2s
7564 !
7565 6 k1 = 1 ; k2 = 2
7566 6 m1 = 1 ; m2 = 2
7567 !
7568 6 first = .false.
7569 endif first_time
7570 !
7571 ! to get tsf climatology at the previous call to sfccycle
7572 !
7573 ! if (fh-deltsfc >= 0.0) then
7574 6 rjdayh = rjday - deltsfc/24.0
7575 ! else
7576 ! rjdayh = rjday
7577 ! endif
7578 ! if(lprnt) print *,' rjdayh=',rjdayh,' mon1=',mon1,' mon2='
7579 ! &,mon2,' mon1s=',mon1s,' mon2s=',mon2s,' k1=',k1,' k2=',k2
7580
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✓ Branch 6 taken 6 times.
✗ Branch 7 not taken.
6 if (rjdayh .ge. dayhf(mon1)) then
7581
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (mon2 .eq. 1) mon2 = 13
7582
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 6 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 6 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 6 times.
6 wei1x = (dayhf(mon2)-rjdayh)/(dayhf(mon2)-dayhf(mon1))
7583 6 wei2x = 1.0 - wei1x
7584
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (mon2 .eq. 13) mon2 = 1
7585 else
7586 rjdayh2 = rjdayh
7587 if (rjdayh .lt. dayhf(1)) rjdayh2 = rjdayh2 + 365.0
7588 if (mon1s .eq. mon1) then
7589 mon1s = mon1 - 1
7590 if (mon1s .eq. 0) mon1s = 12
7591 k2 = k1
7592 k1 = mod(k2,2) + 1
7593 mon = mon1s
7594 kpd7=-1
7595 call fixrdc(lugb,fntsfc,kpdtsf,kpd7,mon,slmask,
7596 & tsf(1,k1),len,iret
7597 &, imsk, jmsk, slmskh, gaus,blno, blto
7598 &, outlat, outlon, me)
7599 tsf(:,k1) = tsf(:,k1) + sst_perturbation
7600 endif
7601 mon2s = mon1s + 1
7602 ! if (mon2s .eq. 1) mon2s = 13
7603 wei1x = (dayhf(mon2s)-rjdayh2)/(dayhf(mon2s)-dayhf(mon1s))
7604 wei2x = 1.0 - wei1x
7605 if (mon2s .eq. 13) mon2s = 1
7606 do i=1,len
7607 tsf2(i) = wei1x * tsf(i,k1) + wei2x * tsf(i,k2)
7608 enddo
7609 endif
7610 !
7611 !cbosu new albedo is monthly
7612
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (sea1 .ne. sea1s) then
7613 sea1s = sea1
7614 sea2s = sea2
7615 m1 = mod(m1,2) + 1
7616 m2 = mod(m1,2) + 1
7617 !
7618 ! seasonal mean climatology
7619 !
7620 isx = sea2/3 + 1
7621 if (isx == 5) isx = 1
7622 if (isx == 1) kpd9 = 12
7623 if (isx == 2) kpd9 = 3
7624 if (isx == 3) kpd9 = 6
7625 if (isx == 4) kpd9 = 9
7626 !
7627 ! albedo
7628 ! there are four albedo fields in this version:
7629 ! two for strong zeneith angle dependent (visible and near ir)
7630 ! and two for weak zeneith angle dependent (vis ans nir)
7631 !
7632 !cbosu
7633 if (ialb == 0) then
7634 kpd7=-1
7635 do k = 1, 4
7636 call fixrdc(lugb,fnalbc,kpdalb(k),kpd7,kpd9,slmask
7637 &, alb(1,k,m2),len,iret
7638 &, imsk, jmsk, slmskh, gaus,blno, blto
7639 &, outlat, outlon, me)
7640 enddo
7641 endif
7642
7643 endif
7644
7645
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (mon1 .ne. mon1s) then
7646
7647 mon1s = mon1
7648 mon2s = mon2
7649 k1 = mod(k1,2) + 1
7650 k2 = mod(k1,2) + 1
7651 !
7652 ! monthly mean climatology
7653 !
7654 mon = mon2
7655 nn = k2
7656 !cbosu
7657 if (ialb == 1) then
7658 if (me == 0) print*,'bosu 2nd time in clima for month ',
7659 & mon, k1,k2
7660 if ( index(fnalbc, "tileX.nc") == 0) then ! grib file
7661 kpd7 = -1
7662 do k = 1, 4
7663 call fixrdc(lugb,fnalbc,kpdalb(k),kpd7,mon,slmask,
7664 & alb(1,k,nn),len,iret
7665 &, imsk, jmsk, slmskh, gaus,blno, blto
7666 &, outlat, outlon, me)
7667 enddo
7668 else
7669 do k = 1, 4
7670 call fixrdc_tile(fnalbc, tile_num_ch, i_index, j_index,
7671 & kpdalb(k), alb(:,k,nn), mon, len, me)
7672 enddo
7673 endif
7674 endif
7675 !
7676 ! tsf at the current time t
7677 !
7678 kpd7 = -1
7679 call fixrdc(lugb,fntsfc,kpdtsf,kpd7,mon,slmask,
7680 & tsf(1,nn),len,iret
7681 &, imsk, jmsk, slmskh, gaus,blno, blto
7682 &, outlat, outlon, me)
7683 tsf(:,nn) = tsf(:,nn) + sst_perturbation
7684 !
7685 ! soil wetness
7686 !
7687 if (fnwetc(1:8).ne.' ') then
7688 kpd7=-1
7689 call fixrdc(lugb,fnwetc,kpdwet,kpd7,mon,slmask,
7690 & wet(1,nn),len,iret
7691 &, imsk, jmsk, slmskh, gaus,blno, blto
7692 &, outlat, outlon, me)
7693 elseif (fnsmcc(1:8).ne.' ') then
7694 if (index(fnsmcc,'global_soilmcpc.1x1.grb') /= 0) then ! the old climo data
7695 kpd7=-1
7696 call fixrdc(lugb,fnsmcc,kpdsmc,kpd7,mon,slmask,
7697 & smc(1,lsoil,nn),len,iret
7698 &, imsk, jmsk, slmskh, gaus,blno, blto
7699 &, outlat, outlon, me)
7700 do l=1,lsoil-1
7701 do i = 1, len
7702 smc(i,l,nn) = smc(i,lsoil,nn)
7703 enddo
7704 enddo
7705 else ! the new gldas data. it does not have data defined at landice
7706 ! points. so for efficiency, don't have fixrdc try to
7707 ! find a value at landice points as defined by the vet type (vet).
7708 allocate(slmask_noice(len))
7709 slmask_noice=1.0
7710 do i = 1, len
7711 if (nint(vet(i)) < 1 .or.
7712 & nint(vet(i)) == landice_cat) then
7713 slmask_noice(i) = 0.0
7714 endif
7715 enddo
7716 do k = 1, lsoil
7717 if (k==1) kpd7=10 ! 0_10 cm (pds octs 11 and 12)
7718 if (k==2) kpd7=2600 ! 10_40 cm
7719 if (k==3) kpd7=10340 ! 40_100 cm
7720 if (k==4) kpd7=25800 ! 100_200 cm
7721 call fixrdc(lugb,fnsmcc,kpdsmc,kpd7,mon,slmask_noice,
7722 & smc(1,k,nn),len,iret
7723 &, imsk, jmsk, slmskh, gaus,blno, blto
7724 &, outlat, outlon, me)
7725 enddo
7726 deallocate(slmask_noice)
7727 endif
7728 else
7729 write(6,*) 'climatological soil wetness file not given'
7730 call abort
7731 endif
7732 !
7733 ! sea ice
7734 !
7735 kpd7 = -1
7736 if (fnacnc(1:8).ne.' ') then
7737 call fixrdc(lugb,fnacnc,kpdacn,kpd7,mon,slmask,
7738 & acn(1,nn),len,iret
7739 &, imsk, jmsk, slmskh, gaus,blno, blto
7740 &, outlat, outlon, me)
7741 elseif (fnaisc(1:8).ne.' ') then
7742 call fixrdc(lugb,fnaisc,kpdais,kpd7,mon,slmask,
7743 & ais(1,nn),len,iret
7744 &, imsk, jmsk, slmskh, gaus,blno, blto
7745 &, outlat, outlon, me)
7746 else
7747 write(6,*) 'climatological ice cover file not given'
7748 call abort
7749 endif
7750 !
7751 ! snow depth
7752 !
7753 kpd7=-1
7754 call fixrdc(lugb,fnsnoc,kpdsno,kpd7,mon,slmask,
7755 & sno(1,nn),len,iret
7756 &, imsk, jmsk, slmskh, gaus,blno, blto
7757 &, outlat, outlon, me)
7758 !
7759 ! snow cover
7760 !
7761 if (fnscvc(1:8).ne.' ') then
7762 kpd7=-1
7763 call fixrdc(lugb,fnscvc,kpdscv,kpd7,mon,slmask,
7764 & scv(1,nn),len,iret
7765 &, imsk, jmsk, slmskh, gaus,blno, blto
7766 &, outlat, outlon, me)
7767 write(6,*) 'climatological snow cover read in.'
7768 endif
7769 !
7770 ! surface roughness
7771 !
7772 if (fnzorc(1:3) == 'sib') then
7773 if (me == 0) then
7774 write(6,*) 'roughness length to be set from sib veg type'
7775 endif
7776 elseif(fnzorc(1:4) == 'igbp') then
7777 if (me == 0) then
7778 write(6,*) 'roughness length to be set from igbp veg type'
7779 endif
7780 else
7781 kpd7=-1
7782 call fixrdc(lugb,fnzorc,kpdzor,kpd7,mon,slmask,
7783 & zor(1,nn),len,iret
7784 &, imsk, jmsk, slmskh, gaus,blno, blto
7785 &, outlat, outlon, me)
7786 endif
7787 !
7788 ! vegetation cover
7789 !
7790 if (fnvegc(1:8) .ne. ' ') then
7791 if ( index(fnvegc, "tileX.nc") == 0) then ! grib file
7792 kpd7=-1
7793 call fixrdc(lugb,fnvegc,kpdveg,kpd7,mon,slmask,
7794 & veg(1,nn),len,iret
7795 &, imsk, jmsk, slmskh, gaus,blno, blto
7796 &, outlat, outlon, me)
7797 else
7798 call fixrdc_tile(fnvegc, tile_num_ch, i_index, j_index,
7799 & kpdveg, veg(:,nn), mon, len, me)
7800 endif
7801 ! if (me .eq. 0) write(6,*) 'climatological vegetation',
7802 ! & ' cover read in for mon=',mon
7803 endif
7804 !
7805 endif
7806 !
7807 ! now perform the time interpolation
7808 !
7809 ! when chosen, set the z0 based on the vegetation type.
7810 ! for this option to work, namelist variable fnvetc must be
7811 ! set to point at the proper vegetation type file.
7812
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (fnzorc(1:3) == 'sib') then
7813 if (fnvetc(1:4) == ' ') then
7814 if (me==0) write(6,*) "must choose sib veg type climo file"
7815 call abort
7816 endif
7817 zorclm = 0.0
7818 do i=1,len
7819 ivtyp = nint(vet(i))
7820 if (ivtyp >= 1 .and. ivtyp <= 13) then
7821 zorclm(i) = z0_sib(ivtyp)
7822 endif
7823 enddo
7824
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 elseif(fnzorc(1:4) == 'igbp') then
7825
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if (fnvetc(1:4) == ' ') then
7826 if (me == 0) write(6,*) "must choose igbp veg type climo file"
7827 call abort
7828 endif
7829
5/8
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 6 times.
✓ Branch 9 taken 13824 times.
✓ Branch 10 taken 6 times.
6 zorclm = 0.0
7830
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
7831
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 ivtyp = nint(vet(i))
7832
3/4
✓ Branch 0 taken 4015 times.
✓ Branch 1 taken 9809 times.
✓ Branch 2 taken 4015 times.
✗ Branch 3 not taken.
13830 if (ivtyp >= 1 .and. ivtyp <= 20) then
7833
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 4015 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4015 times.
4015 z0_season(1) = z0_igbp_min(ivtyp)
7834
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 4015 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4015 times.
4015 z0_season(7) = z0_igbp_max(ivtyp)
7835
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 4015 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4015 times.
✓ Branch 6 taken 1317 times.
✓ Branch 7 taken 2698 times.
4015 if (outlat(i) < 0.0) then
7836
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 1317 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1317 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1317 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1317 times.
1317 zorclm(i) = wei1y * z0_season(hyr2) +
7837
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1317 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1317 times.
1317 & wei2y * z0_season(hyr1)
7838 else
7839
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 2698 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 2698 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 2698 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 2698 times.
2698 zorclm(i) = wei1y * z0_season(hyr1) +
7840
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 2698 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 2698 times.
2698 & wei2y * z0_season(hyr2)
7841 endif
7842 endif
7843 enddo
7844 else
7845 do i=1,len
7846 zorclm(i) = wei1m * zor(i,k1) + wei2m * zor(i,k2)
7847 enddo
7848 endif
7849 !
7850
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
7851
10/20
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 13824 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 13824 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 13824 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 13824 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 13824 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 13824 times.
13824 tsfclm(i) = wei1m * tsf(i,k1) + wei2m * tsf(i,k2)
7852
10/20
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 13824 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 13824 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 13824 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 13824 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 13824 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 13824 times.
13824 snoclm(i) = wei1m * sno(i,k1) + wei2m * sno(i,k2)
7853
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 cvclm(i) = 0.0
7854
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 cvbclm(i) = 0.0
7855
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 cvtclm(i) = 0.0
7856
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
13824 cnpclm(i) = 0.0
7857
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 tsfcl2(i) = tsf2(i)
7858 enddo
7859 ! if(lprnt) print *,' tsfclm=',tsfclm(iprnt),' wei1m=',wei1m
7860 ! &,' wei2m=',wei2m,' tsfk12=',tsf(iprnt,k1),tsf(iprnt,k2)
7861 !
7862
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (fh .eq. 0.0) then
7863
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
7864
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 tsfcl0(i) = tsfclm(i)
7865 enddo
7866 endif
7867
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 6 times.
✓ Branch 6 taken 6 times.
✗ Branch 7 not taken.
6 if (rjdayh .ge. dayhf(mon1)) then
7868
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
7869
10/20
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 13824 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 13824 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 13824 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 13824 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 13824 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 13824 times.
13824 tsf2(i) = wei1x * tsf(i,k1) + wei2x * tsf(i,k2)
7870
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 tsfcl2(i) = tsf2(i)
7871 enddo
7872 endif
7873 ! if(lprnt) print *,' tsf2=',tsf2(iprnt),' wei1x=',wei1x
7874 ! &,' wei2x=',wei2x,' tsfk12=',tsf(iprnt,k1),tsf(iprnt,k2)
7875 ! &,' mon1s=',mon1s,' mon2s=',mon2s
7876 ! &,' slmask=',slmask(iprnt)
7877 !
7878
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnacnc(1:8).ne.' ') then
7879 do i=1,len
7880 acnclm(i) = wei1m * acn(i,k1) + wei2m * acn(i,k2)
7881 enddo
7882
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 elseif(fnaisc(1:8).ne.' ') then
7883
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
7884
10/20
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 13824 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 13824 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 13824 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 13824 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 13824 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 13824 times.
13830 aisclm(i) = wei1m * ais(i,k1) + wei2m * ais(i,k2)
7885 enddo
7886 endif
7887 !
7888
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnwetc(1:8).ne.' ') then
7889 do i=1,len
7890 wetclm(i) = wei1m * wet(i,k1) + wei2m * wet(i,k2)
7891 enddo
7892
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 elseif(fnsmcc(1:8).ne.' ') then
7893
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do k=1,lsoil
7894
2/2
✓ Branch 0 taken 55296 times.
✓ Branch 1 taken 24 times.
55326 do i=1,len
7895
16/32
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 55296 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 55296 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 55296 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 55296 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 55296 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 55296 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 55296 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 55296 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 55296 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 55296 times.
✗ Branch 36 not taken.
✓ Branch 37 taken 55296 times.
✗ Branch 39 not taken.
✓ Branch 40 taken 55296 times.
✗ Branch 42 not taken.
✓ Branch 43 taken 55296 times.
✗ Branch 45 not taken.
✓ Branch 46 taken 55296 times.
55320 smcclm(i,k) = wei1m * smc(i,k,k1) + wei2m * smc(i,k,k2)
7896 enddo
7897 enddo
7898 endif
7899 !
7900
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
6 if(fnscvc(1:8).ne.' ') then
7901 do i=1,len
7902 scvclm(i) = wei1m * scv(i,k1) + wei2m * scv(i,k2)
7903 enddo
7904 endif
7905 !
7906
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fntg3c(1:8).ne.' ') then
7907
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
7908
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 tg3clm(i) = tg3(i)
7909 enddo
7910 elseif(fnstcc(1:8).ne.' ') then
7911 do k=1,lsoil
7912 do i=1,len
7913 stcclm(i,k) = wei1m * stc(i,k,k1) + wei2m * stc(i,k,k2)
7914 enddo
7915 enddo
7916 endif
7917 !
7918
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnvegc(1:8).ne.' ') then
7919
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
7920
10/20
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 13824 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 13824 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 13824 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 13824 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 13824 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 13824 times.
13830 vegclm(i) = wei1m * veg(i,k1) + wei2m * veg(i,k2)
7921 enddo
7922 endif
7923 !
7924
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnvetc(1:8).ne.' ') then
7925
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
7926
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 vetclm(i) = vet(i)
7927 enddo
7928 endif
7929 !
7930
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnsotc(1:8).ne.' ') then
7931
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
7932
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 sotclm(i) = sot(i)
7933 enddo
7934 endif
7935
7936
7937 !clu ----------------------------------------------------------------------
7938 !
7939
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnvmnc(1:8).ne.' ') then
7940
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
7941
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 vmnclm(i) = vmn(i)
7942 enddo
7943 endif
7944 !
7945
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnvmxc(1:8).ne.' ') then
7946
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
7947
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 vmxclm(i) = vmx(i)
7948 enddo
7949 endif
7950 !
7951
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnslpc(1:8).ne.' ') then
7952
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
7953
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 slpclm(i) = slp(i)
7954 enddo
7955 endif
7956 !
7957
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if(fnabsc(1:8).ne.' ') then
7958
2/2
✓ Branch 0 taken 13824 times.
✓ Branch 1 taken 6 times.
13830 do i=1,len
7959
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 13824 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13824 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 13824 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 13824 times.
13830 absclm(i) = absm(i)
7960 enddo
7961 endif
7962 !clu ----------------------------------------------------------------------
7963 !
7964 !cbosu diagnostic print
7965
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 5 times.
7 if (me == 0) print*,'monthly albedo weights are ',
7966 2 & wei1m,' for k', k1, wei2m, ' for k', k2
7967
7968
1/2
✓ Branch 0 taken 6 times.
✗ Branch 1 not taken.
6 if (ialb == 1) then
7969
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 6 times.
30 do k=1,4
7970
2/2
✓ Branch 0 taken 55296 times.
✓ Branch 1 taken 24 times.
55326 do i=1,len
7971
16/32
✗ Branch 0 not taken.
✓ Branch 1 taken 55296 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 55296 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 55296 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 55296 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 55296 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 55296 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 55296 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 55296 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 55296 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 55296 times.
✗ Branch 30 not taken.
✓ Branch 31 taken 55296 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 55296 times.
✗ Branch 36 not taken.
✓ Branch 37 taken 55296 times.
✗ Branch 39 not taken.
✓ Branch 40 taken 55296 times.
✗ Branch 42 not taken.
✓ Branch 43 taken 55296 times.
✗ Branch 45 not taken.
✓ Branch 46 taken 55296 times.
55320 albclm(i,k) = wei1m * alb(i,k,k1) + wei2m * alb(i,k,k2)
7972 enddo
7973 enddo
7974 else
7975 do k=1,4
7976 do i=1,len
7977 albclm(i,k) = wei1s * alb(i,k,m1) + wei2s * alb(i,k,m2)
7978 enddo
7979 enddo
7980 endif
7981 !
7982
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 6 times.
18 do k=1,2
7983
2/2
✓ Branch 0 taken 27648 times.
✓ Branch 1 taken 12 times.
27666 do i=1,len
7984
8/16
✗ Branch 0 not taken.
✓ Branch 1 taken 27648 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 27648 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 27648 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 27648 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 27648 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 27648 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 27648 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 27648 times.
27660 alfclm(i,k) = alf(i,k)
7985 enddo
7986 enddo
7987 !
7988 ! end of climatology reads
7989 !
7990 12 return
7991
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 6 times.
12 end subroutine clima
7992 subroutine fixrdc_tile(filename_raw, tile_num_ch,
7993 & i_index, j_index, kpds,
7994 & var, mon, npts, me)
7995 use netcdf
7996 use machine , only : kind_io8
7997 implicit none
7998 character(len=*), intent(in) :: filename_raw
7999 character(len=*), intent(in) :: tile_num_ch
8000 integer, intent(in) :: npts, me, kpds, mon
8001 integer, intent(in) :: i_index(npts)
8002 integer, intent(in) :: j_index(npts)
8003 real(kind_io8), intent(out) :: var(npts)
8004 character(len=500) :: filename
8005 character(len=80) :: errmsg
8006 integer :: i, ii, ncid, t
8007 integer :: error, id_dim
8008 integer :: nx, ny, num_times
8009 integer :: id_var
8010 real(kind=4), allocatable :: dummy(:,:,:)
8011 ii=index(filename_raw,"tileX")
8012
8013 do i = 1, len(filename)
8014 filename(i:i) = " "
8015 enddo
8016
8017 filename = filename_raw(1:ii-1) // tile_num_ch // ".nc"
8018
8019 if (me == 0) print*, ' in fixrdc_tile for mon=',mon,
8020 & ' filename=', trim(filename)
8021
8022 error=nf90_open(trim(filename), nf90_nowrite, ncid)
8023 if (error /= nf90_noerr) call netcdf_err(error)
8024
8025 error=nf90_inq_dimid(ncid, 'nx', id_dim)
8026 if (error /= nf90_noerr) call netcdf_err(error)
8027 error=nf90_inquire_dimension(ncid,id_dim,len=nx)
8028 if (error /= nf90_noerr) call netcdf_err(error)
8029
8030 error=nf90_inq_dimid(ncid, 'ny', id_dim)
8031 if (error /= nf90_noerr) call netcdf_err(error)
8032 error=nf90_inquire_dimension(ncid,id_dim,len=ny)
8033 if (error /= nf90_noerr) call netcdf_err(error)
8034
8035 error=nf90_inq_dimid(ncid, 'time', id_dim)
8036 if (error /= nf90_noerr) call netcdf_err(error)
8037 error=nf90_inquire_dimension(ncid,id_dim,len=num_times)
8038 if (error /= nf90_noerr) call netcdf_err(error)
8039
8040 select case (kpds)
8041 case(11)
8042 error=nf90_inq_varid(ncid, 'substrate_temperature', id_var)
8043 case(87)
8044 error=nf90_inq_varid(ncid, 'vegetation_greenness', id_var)
8045 case(159)
8046 error=nf90_inq_varid(ncid, 'maximum_snow_albedo', id_var)
8047 case(189)
8048 error=nf90_inq_varid(ncid, 'visible_black_sky_albedo', id_var)
8049 case(190)
8050 error=nf90_inq_varid(ncid, 'visible_white_sky_albedo', id_var)
8051 case(191)
8052 error=nf90_inq_varid(ncid, 'near_IR_black_sky_albedo', id_var)
8053 case(192)
8054 error=nf90_inq_varid(ncid, 'near_IR_white_sky_albedo', id_var)
8055 case(214)
8056 error=nf90_inq_varid(ncid, 'facsf', id_var)
8057 case(224)
8058 error=nf90_inq_varid(ncid, 'soil_type', id_var)
8059 case(225)
8060 error=nf90_inq_varid(ncid, 'vegetation_type', id_var)
8061 case(236)
8062 error=nf90_inq_varid(ncid, 'slope_type', id_var)
8063 case(256:257)
8064 error=nf90_inq_varid(ncid, 'vegetation_greenness', id_var)
8065 case default
8066 print*,'fatal error in fixrdc_tile of sfcsub.F.'
8067 print*,'unknown variable.'
8068 call abort
8069 end select
8070 if (error /= nf90_noerr) call netcdf_err(error)
8071
8072 allocate(dummy(nx,ny,1))
8073
8074 if (kpds == 256) then ! max veg greenness
8075
8076 var = -9999.
8077 do t = 1, num_times
8078 error=nf90_get_var(ncid, id_var, dummy, start=(/1,1,t/),
8079 & count=(/nx,ny,1/) )
8080 if (error /= nf90_noerr) call netcdf_err(error)
8081 do ii = 1,npts
8082 var(ii) = max(var(ii), dummy(i_index(ii),j_index(ii),1))
8083 enddo
8084 enddo
8085
8086 elseif (kpds == 257) then ! min veg greenness
8087
8088 var = 9999.
8089 do t = 1, num_times
8090 error=nf90_get_var(ncid, id_var, dummy, start=(/1,1,t/),
8091 & count=(/nx,ny,1/) )
8092 if (error /= nf90_noerr) call netcdf_err(error)
8093 do ii = 1, npts
8094 var(ii) = min(var(ii), dummy(i_index(ii),j_index(ii),1))
8095 enddo
8096 enddo
8097
8098 else
8099
8100 error=nf90_get_var(ncid, id_var, dummy, start=(/1,1,mon/),
8101 & count=(/nx,ny,1/) )
8102 if (error /= nf90_noerr) call netcdf_err(error)
8103
8104 do ii = 1, npts
8105 var(ii) = dummy(i_index(ii),j_index(ii),1)
8106 enddo
8107
8108 endif
8109
8110 deallocate(dummy)
8111
8112 error=nf90_close(ncid)
8113
8114 select case (kpds)
8115 case(159) ! max snow alb
8116 var = var * 100.0
8117 case(214) ! facsf
8118 where (var < 0.0) var = 0.0
8119 var = var * 100.0
8120 case(189:192)
8121 var = var * 100.0
8122 case(256:257)
8123 var = var * 100.0
8124 end select
8125
8126 return
8127
8128 end subroutine fixrdc_tile
8129 subroutine netcdf_err(error)
8130
8131 use netcdf
8132 implicit none
8133
8134 integer,intent(in) :: error
8135 character(len=256) :: errmsg
8136
8137 errmsg = nf90_strerror(error)
8138 print*,'fatal error in sfcsub.F: ', trim(errmsg)
8139 call abort
8140
8141 end subroutine netcdf_err
8142
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
612 subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask,
8143 204 & gdata,len,iret
8144 204 &, imsk, jmsk, slmskh, gaus,blno, blto
8145 204 &, outlat, outlon, me)
8146 use machine , only : kind_io8,kind_io4
8147 use sfccyc_module, only : mdata
8148 implicit none
8149 1020 integer imax,jmax,ijmax,i,j,n,jret,inttyp,iret,imsk,
8150 612 & jmsk,len,lugb,kpds5,mon,lskip,lgrib,ndata,lugi,me,kmami
8151 408 &, jj,w3kindreal,w3kindint
8152 612 real (kind=kind_io8) wlon,elon,rnlat,dlat,dlon,rslat,blno,blto
8153 !
8154 ! read in grib climatology files and interpolate to the input
8155 ! grid. grib files should allow all the necessary parameters
8156 ! to be extracted from the description records.
8157 !
8158 !
8159 character*500 fngrib
8160 ! character*80 fngrib, asgnstr
8161 !
8162 real (kind=kind_io8) slmskh(imsk,jmsk)
8163 !
8164 real (kind=kind_io8) gdata(len), slmask(len)
8165 408 real (kind=kind_io8), allocatable :: data(:,:), rslmsk(:,:)
8166 204 real (kind=kind_io8), allocatable :: data8(:)
8167 204 real (kind=kind_io4), allocatable :: data4(:)
8168 204 real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:)
8169 !
8170 612 logical lmask, yr2kc, gaus, ijordr
8171 204 logical*1, allocatable :: lbms(:)
8172 !
8173 integer, intent(in) :: kpds7
8174
4/4
✓ Branch 0 taken 204000 times.
✓ Branch 1 taken 204 times.
✓ Branch 2 taken 204000 times.
✓ Branch 3 taken 204 times.
204 integer kpds(1000),kgds(1000)
8175
6/6
✓ Branch 0 taken 204000 times.
✓ Branch 1 taken 204 times.
✓ Branch 2 taken 204000 times.
✓ Branch 3 taken 204 times.
✓ Branch 4 taken 204000 times.
✓ Branch 5 taken 204 times.
612 integer jpds(1000),jgds(1000), kpds0(1000)
8176 real (kind=kind_io8) outlat(len), outlon(len)
8177 !
8178
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 204 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 204 times.
204 allocate(data8(1:mdata))
8179
3/6
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 204 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 204 times.
204 allocate(lbms(mdata))
8180 !
8181 ! integer imax_sv, jmax_sv, wlon_sv, rnlat_sv, kpds1_sv
8182 ! date imax_sv/0/, jmax_sv/0/, wlon_sv/999.0/, rnlat_sv/999.0/
8183 ! &, kpds1_sv/-1/
8184 ! save imax_sv, jmax_sv, wlon_sv, rnlat_sv, kpds1_sv
8185 ! &, rlngrb, rltgrb
8186 !
8187 204 iret = 0
8188 !
8189
2/2
✓ Branch 0 taken 34 times.
✓ Branch 1 taken 170 times.
238 if (me .eq. 0) write(6,*) ' in fixrdc for mon=',mon
8190
1/2
✓ Branch 4 taken 34 times.
✗ Branch 5 not taken.
68 &,' fngrib=',trim(fngrib)
8191 !
8192 204 close(lugb)
8193 204 call baopenr(lugb,fngrib,iret)
8194
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
204 if (iret .ne. 0) then
8195 write(6,*) ' error in opening file ',trim(fngrib)
8196 print *,'error in opening file ',trim(fngrib)
8197 call abort
8198 endif
8199
3/4
✓ Branch 0 taken 34 times.
✓ Branch 1 taken 170 times.
✓ Branch 5 taken 34 times.
✗ Branch 6 not taken.
238 if (me .eq. 0) write(6,*) ' file ',trim(fngrib),
8200 68 & ' opened. unit=',lugb
8201 !
8202 204 lugi = 0
8203 !
8204 204 lskip = -1
8205
2/2
✓ Branch 0 taken 204000 times.
✓ Branch 1 taken 204 times.
204 jpds = -1
8206
2/2
✓ Branch 0 taken 204000 times.
✓ Branch 1 taken 204 times.
204 jgds = -1
8207 204 jpds(5) = kpds5
8208 204 jpds(7) = kpds7
8209 204 kpds = jpds
8210 call getgbh(lugb,lugi,lskip,jpds,jgds,lgrib,ndata,
8211 204 & lskip,kpds,kgds,iret)
8212
2/2
✓ Branch 0 taken 34 times.
✓ Branch 1 taken 170 times.
204 if (me .eq. 0) then
8213 34 write(6,*) ' first grib record.'
8214
5/8
✓ Branch 2 taken 374 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 340 times.
✓ Branch 5 taken 34 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 340 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 340 times.
34 write(6,*) ' kpds( 1-10)=',(kpds(j),j= 1,10)
8215
5/8
✓ Branch 2 taken 374 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 340 times.
✓ Branch 5 taken 34 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 340 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 340 times.
34 write(6,*) ' kpds(11-20)=',(kpds(j),j=11,20)
8216
5/8
✓ Branch 2 taken 102 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 68 times.
✓ Branch 5 taken 34 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 68 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 68 times.
34 write(6,*) ' kpds(21- )=',(kpds(j),j=21,22)
8217 endif
8218 204 yr2kc = (kpds(8) / 100) .gt. 0
8219 204 kpds0 = jpds
8220 204 kpds0(4) = -1
8221 204 kpds0(18) = -1
8222
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
204 if(iret.ne.0) then
8223 write(6,*) ' error in getgbh. iret: ', iret
8224 if (iret==99) write(6,*) ' field not found.'
8225 call abort
8226 endif
8227 !
8228 ! handling climatology file
8229 !
8230 204 lskip = -1
8231 204 n = 0
8232 204 jpds = kpds0
8233 204 jpds(9) = mon
8234
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
204 if(jpds(9).eq.13) jpds(9) = 1
8235 204 call w3kind(w3kindreal,w3kindint)
8236
1/2
✓ Branch 0 taken 204 times.
✗ Branch 1 not taken.
204 if (w3kindreal==8) then
8237 call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip,
8238 204 & kpds,kgds,lbms,data8,jret)
8239 else if (w3kindreal==4) then
8240 allocate(data4(1:mdata))
8241 call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip,
8242 & kpds,kgds,lbms,data4,jret)
8243 data8 = real(data4, kind=kind_io8)
8244 deallocate(data4)
8245 endif
8246
2/2
✓ Branch 0 taken 34 times.
✓ Branch 1 taken 170 times.
238 if (me .eq. 0) write(6,*) ' input grib file dates=',
8247
5/8
✓ Branch 1 taken 170 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 136 times.
✓ Branch 4 taken 34 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 136 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 136 times.
68 & (kpds(i),i=8,11)
8248
1/2
✓ Branch 0 taken 204 times.
✗ Branch 1 not taken.
204 if(jret.eq.0) then
8249
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
204 if(ndata.eq.0) then
8250 write(6,*) ' error in getgb'
8251 write(6,*) ' kpds=',kpds
8252 write(6,*) ' kgds=',kgds
8253 call abort
8254 endif
8255 204 imax=kgds(2)
8256 204 jmax=kgds(3)
8257 204 ijmax=imax*jmax
8258
9/18
✓ Branch 0 taken 204 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 204 times.
✓ Branch 4 taken 204 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 204 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 204 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 204 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 204 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 204 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 204 times.
204 allocate (data(imax,jmax))
8259
2/2
✓ Branch 0 taken 240432 times.
✓ Branch 1 taken 204 times.
240636 do j=1,jmax
8260 240432 jj = (j-1)*imax
8261
2/2
✓ Branch 0 taken 729293376 times.
✓ Branch 1 taken 240432 times.
729534012 do i=1,imax
8262
6/12
✗ Branch 0 not taken.
✓ Branch 1 taken 729293376 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 729293376 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 729293376 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 729293376 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 729293376 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 729293376 times.
729533808 data(i,j) = data8(jj+i)
8263 enddo
8264 enddo
8265
2/2
✓ Branch 0 taken 34 times.
✓ Branch 1 taken 170 times.
204 if (me .eq. 0) write(6,*) 'imax,jmax,ijmax=',imax,jmax,ijmax
8266 else
8267 write(6,*) ' error in getgb - jret=', jret
8268 call abort
8269 endif
8270 !
8271 ! if (me == 0) then
8272 ! write(6,*) ' maxmin of input as is'
8273 ! kmami=1
8274 ! call maxmin(data(1,1),ijmax,kmami)
8275 ! endif
8276 !
8277 204 call getarea(kgds,dlat,dlon,rslat,rnlat,wlon,elon,ijordr,me)
8278
2/2
✓ Branch 0 taken 34 times.
✓ Branch 1 taken 170 times.
204 if (me == 0) then
8279 34 write(6,*) 'imax,jmax,ijmax,dlon,dlat,ijordr,wlon,rnlat='
8280 34 write(6,*) imax,jmax,ijmax,dlon,dlat,ijordr,wlon,rnlat
8281 endif
8282 204 call subst(data,imax,jmax,dlon,dlat,ijordr)
8283 !
8284 ! first get slmask over input grid
8285 !
8286
14/28
✓ Branch 0 taken 204 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 204 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 204 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 204 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 204 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 204 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 204 times.
✓ Branch 17 taken 204 times.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
✓ Branch 20 taken 204 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 204 times.
✗ Branch 23 not taken.
✓ Branch 24 taken 204 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 204 times.
✗ Branch 28 not taken.
✓ Branch 29 taken 204 times.
✗ Branch 31 not taken.
✓ Branch 32 taken 204 times.
204 allocate (rlngrb(imax), rltgrb(jmax))
8287
9/18
✓ Branch 0 taken 204 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 204 times.
✓ Branch 4 taken 204 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 204 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 204 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 204 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 204 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 204 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 204 times.
204 allocate (rslmsk(imax,jmax))
8288
8289 call setrmsk(kpds5,slmskh,imsk,jmsk,wlon,rnlat,
8290 & data,imax,jmax,rlngrb,rltgrb,lmask,rslmsk
8291 204 &, gaus,blno, blto, kgds(1), kpds(4), lbms)
8292 ! write(6,*) ' kpds5=',kpds5,' lmask=',lmask
8293 !
8294 204 inttyp = 0
8295
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 198 times.
204 if(kpds5.eq.225) inttyp = 1
8296
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
204 if(kpds5.eq.230) inttyp = 1
8297
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 198 times.
204 if(kpds5.eq.236) inttyp = 1
8298
2/2
✓ Branch 0 taken 6 times.
✓ Branch 1 taken 198 times.
204 if(kpds5.eq.224) inttyp = 1
8299
2/2
✓ Branch 0 taken 34 times.
✓ Branch 1 taken 170 times.
204 if (me .eq. 0) then
8300
2/2
✓ Branch 0 taken 3 times.
✓ Branch 1 taken 31 times.
37 if(inttyp.eq.1) print *, ' nearest grid point used'
8301 6 &, ' kpds5=',kpds5, ' lmask = ',lmask
8302 endif
8303 !
8304 call la2ga(data,imax,jmax,rlngrb,rltgrb,wlon,rnlat,inttyp,
8305 & gdata,len,lmask,rslmsk,slmask
8306 204 &, outlat, outlon,me)
8307 !
8308
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
204 deallocate (rlngrb, stat=iret)
8309
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
204 deallocate (rltgrb, stat=iret)
8310
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
204 deallocate (data, stat=iret)
8311
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
204 deallocate (rslmsk, stat=iret)
8312 204 call baclose(lugb,iret)
8313 !
8314
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
204 deallocate(data8)
8315
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
204 deallocate(lbms)
8316 408 return
8317
7/14
✗ Branch 0 not taken.
✓ Branch 1 taken 204 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 204 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 204 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 204 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 204 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 204 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 204 times.
204 end subroutine fixrdc
8318 subroutine fixrda(lugb,fngrib,kpds5,slmask,
8319 & iy,im,id,ih,fh,gdata,len,iret
8320 &, imsk, jmsk, slmskh, gaus,blno, blto
8321 &, outlat, outlon, me)
8322 use machine , only : kind_io8,kind_io4
8323 use sfccyc_module, only : mdata
8324 implicit none
8325 integer nrepmx,nvalid,imo,iyr,idy,jret,ihr,nrept,lskip,lugi,
8326 & lgrib,j,ndata,i,inttyp,jmax,imax,ijmax,ij,jday,len,iret,
8327 & jmsk,imsk,ih,kpds5,lugb,iy,id,im,jh,jd,jdoy,jdow,jm,me,
8328 & monend,jy,iy4,kmami,iret2,jj,w3kindreal,w3kindint
8329 real (kind=kind_io8) rnlat,rslat,wlon,elon,dlon,dlat,fh,blno,
8330 & rjday,blto
8331 !
8332 ! read in grib climatology/analysis files and interpolate to the input
8333 ! dates and the grid. grib files should allow all the necessary parameters
8334 ! to be extracted from the description records.
8335 !
8336 ! nrepmx: max number of days for going back date search
8337 ! nvalid: analysis later than (current date - nvalid) is regarded as
8338 ! valid for current analysis
8339 !
8340 parameter(nrepmx=15, nvalid=4)
8341 !
8342 character*500 fngrib
8343 ! character*80 fngrib, asgnstr
8344 !
8345 real (kind=kind_io8) slmskh(imsk,jmsk)
8346 !
8347 real (kind=kind_io8) gdata(len), slmask(len)
8348 real (kind=kind_io8), allocatable :: data(:,:),rslmsk(:,:)
8349 real (kind=kind_io8), allocatable :: data8(:)
8350 real (kind=kind_io4), allocatable :: data4(:)
8351 real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:)
8352 !
8353 logical lmask, yr2kc, gaus, ijordr
8354 logical*1 lbms(mdata)
8355 !
8356 integer kpds(1000),kgds(1000)
8357 integer jpds(1000),jgds(1000), kpds0(1000)
8358 real (kind=kind_io8) outlat(len), outlon(len)
8359 !
8360 ! dayhf : julian day of the middle of each month
8361 !
8362 real (kind=kind_io8) dayhf(13)
8363 data dayhf/ 15.5, 45.0, 74.5,105.0,135.5,166.0,
8364 & 196.5,227.5,258.0,288.5,319.0,349.5,380.5/
8365 !
8366 ! mjday : number of days in a month
8367 !
8368 integer mjday(12)
8369 data mjday/31,28,31,30,31,30,31,31,30,31,30,31/
8370 !
8371 real (kind=kind_io8) fha(5)
8372 real(4) fha4(5)
8373 integer ida(8),jda(8)
8374 !
8375 allocate(data8(1:mdata))
8376 iret = 0
8377 monend = 9999
8378 !
8379 ! compute jy,jm,jd,jh of forecast and the day of the year
8380 !
8381 iy4=iy
8382 if(iy.lt.101) iy4=1900+iy4
8383 fha=0
8384 ida=0
8385 jda=0
8386 fha(2)=nint(fh)
8387 ida(1)=iy
8388 ida(2)=im
8389 ida(3)=id
8390 ida(5)=ih
8391 call w3kind(w3kindreal,w3kindint)
8392 if(w3kindreal==4) then
8393 fha4=fha
8394 call w3movdat(fha4,ida,jda)
8395 else
8396 call w3movdat(fha,ida,jda)
8397 endif
8398 jy=jda(1)
8399 jm=jda(2)
8400 jd=jda(3)
8401 jh=jda(5)
8402 ! if (me .eq. 0) write(6,*) ' forecast jy,jm,jd,jh,rjday=',
8403 ! & jy,jm,jd,jh,rjday
8404 jdow = 0
8405 jdoy = 0
8406 jday = 0
8407 call w3doxdat(jda,jdow,jdoy,jday)
8408 rjday=jdoy+jda(5)/24.
8409 if(rjday.lt.dayhf(1)) rjday=rjday+365.
8410
8411 if (me .eq. 0) write(6,*) ' forecast jy,jm,jd,jh,rjday=',
8412 & jy,jm,jd,jh,rjday
8413 !
8414 if (me .eq. 0) then
8415 write(6,*) 'forecast jy,jm,jd,jh=',jy,jm,jd,jh
8416 !
8417 write(6,*) ' '
8418 write(6,*) '************************************************'
8419 endif
8420 !
8421 close(lugb)
8422 call baopenr(lugb,fngrib,iret)
8423 if (iret .ne. 0) then
8424 write(6,*) ' error in opening file ',trim(fngrib)
8425 print *,'error in opening file ',trim(fngrib)
8426 call abort
8427 endif
8428 if (me .eq. 0) write(6,*) ' file ',trim(fngrib),
8429 & ' opened. unit=',lugb
8430 !
8431 lugi = 0
8432 !
8433 lskip=-1
8434 jpds=-1
8435 jgds=-1
8436 jpds(5)=kpds5
8437 kpds = jpds
8438 call getgbh(lugb,lugi,lskip,jpds,jgds,lgrib,ndata,
8439 & lskip,kpds,kgds,iret)
8440 if (me .eq. 0) then
8441 write(6,*) ' first grib record.'
8442 write(6,*) ' kpds( 1-10)=',(kpds(j),j= 1,10)
8443 write(6,*) ' kpds(11-20)=',(kpds(j),j=11,20)
8444 write(6,*) ' kpds(21- )=',(kpds(j),j=21,22)
8445 endif
8446 yr2kc = (kpds(8) / 100) .gt. 0
8447 kpds0=jpds
8448 kpds0(4)=-1
8449 kpds0(18)=-1
8450 if(iret.ne.0) then
8451 write(6,*) ' error in getgbh. iret: ', iret
8452 if(iret==99) write(6,*) ' field not found.'
8453 call abort
8454 endif
8455 !
8456 ! handling analysis file
8457 !
8458 ! find record for the given hour/day/month/year
8459 !
8460 nrept=0
8461 jpds=kpds0
8462 lskip = -1
8463 iyr=jy
8464 if(iyr.le.100) iyr=2050-mod(2050-iyr,100)
8465 imo=jm
8466 idy=jd
8467 ihr=jh
8468 ! year 2000 compatible data
8469 if (yr2kc) then
8470 jpds(8) = iyr
8471 else
8472 jpds(8) = mod(iyr,1900)
8473 endif
8474 50 continue
8475 jpds( 8)=mod(iyr-1,100)+1
8476 jpds( 9)=imo
8477 jpds(10)=idy
8478 ! jpds(11)=ihr
8479 jpds(21)=(iyr-1)/100+1
8480 call w3kind(w3kindreal,w3kindint)
8481 if (w3kindreal == 8) then
8482 call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip,
8483 & kpds,kgds,lbms,data8,jret)
8484 elseif (w3kindreal == 4) then
8485 allocate (data4(1:mdata))
8486 call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip,
8487 & kpds,kgds,lbms,data4,jret)
8488 data8 = real(data4, kind=kind_io8)
8489 deallocate(data4)
8490 endif
8491 if (me .eq. 0) write(6,*) ' input grib file dates=',
8492 & (kpds(i),i=8,11)
8493 if(jret.eq.0) then
8494 if(ndata.eq.0) then
8495 write(6,*) ' error in getgb'
8496 write(6,*) ' kpds=',kpds
8497 write(6,*) ' kgds=',kgds
8498 call abort
8499 endif
8500 imax=kgds(2)
8501 jmax=kgds(3)
8502 ijmax=imax*jmax
8503 allocate (data(imax,jmax))
8504 do j=1,jmax
8505 jj = (j-1)*imax
8506 do i=1,imax
8507 data(i,j) = data8(jj+i)
8508 enddo
8509 enddo
8510 else
8511 if(nrept.eq.0) then
8512 if (me .eq. 0) then
8513 write(6,*) ' no matching dates found. start searching',
8514 & ' nearest matching dates (going back).'
8515 endif
8516 endif
8517 !
8518 ! no matching ih found. search nearest hour
8519 !
8520 if(ihr.eq.6) then
8521 ihr=0
8522 go to 50
8523 elseif(ihr.eq.12) then
8524 ihr=0
8525 go to 50
8526 elseif(ihr.eq.18) then
8527 ihr=12
8528 go to 50
8529 elseif(ihr.eq.0.or.ihr.eq.-1) then
8530 idy=idy-1
8531 if(idy.eq.0) then
8532 imo=imo-1
8533 if(imo.eq.0) then
8534 iyr=iyr-1
8535 if(iyr.lt.0) iyr=99
8536 imo=12
8537 endif
8538 idy=31
8539 if(imo.eq.4.or.imo.eq.6.or.imo.eq.9.or.imo.eq.11) idy=30
8540 if(imo.eq.2) then
8541 if(mod(iyr,4).eq.0) then
8542 idy=29
8543 else
8544 idy=28
8545 endif
8546 endif
8547 endif
8548 ihr=-1
8549 if (me .eq. 0) write(6,*) ' decremented dates=',
8550 & iyr,imo,idy,ihr
8551 nrept=nrept+1
8552 if(nrept.gt.nvalid) iret=-1
8553 if(nrept.gt.nrepmx) then
8554 if (me .eq. 0) then
8555 write(6,*) ' <warning:cycl> searching range exceeded.'
8556 &, ' may be wrong grib file given'
8557 write(6,*) ' <warning:cycl> fngrib=',trim(fngrib)
8558 write(6,*) ' <warning:cycl> terminating search and',
8559 & ' and setting gdata to -999'
8560 write(6,*) ' range max=',nrepmx
8561 endif
8562 ! imax=kgds(2)
8563 ! jmax=kgds(3)
8564 ! ijmax=imax*jmax
8565 ! do ij=1,ijmax
8566 ! data(ij)=0.
8567 ! enddo
8568 go to 100
8569 endif
8570 go to 50
8571 else
8572 if (me .eq. 0) then
8573 write(6,*) ' search of analysis for ihr=',ihr,' failed.'
8574 write(6,*) ' kpds=',kpds
8575 write(6,*) ' iyr,imo,idy,ihr=',iyr,imo,idy,ihr
8576 endif
8577 go to 100
8578 endif
8579 endif
8580 !
8581 80 continue
8582 ! if (me == 0) then
8583 ! write(6,*) ' maxmin of input as is'
8584 ! kmami=1
8585 ! call maxmin(data(1,1),ijmax,kmami)
8586 ! endif
8587 !
8588 call getarea(kgds,dlat,dlon,rslat,rnlat,wlon,elon,ijordr,me)
8589 if (me == 0) then
8590 write(6,*) 'imax,jmax,ijmax,dlon,dlat,ijordr,wlon,rnlat='
8591 write(6,*) imax,jmax,ijmax,dlon,dlat,ijordr,wlon,rnlat
8592 endif
8593 call subst(data,imax,jmax,dlon,dlat,ijordr)
8594 !
8595 ! first get slmask over input grid
8596 !
8597 allocate (rlngrb(imax), rltgrb(jmax))
8598 allocate (rslmsk(imax,jmax))
8599 call setrmsk(kpds5,slmskh,imsk,jmsk,wlon,rnlat,
8600 & data,imax,jmax,rlngrb,rltgrb,lmask,rslmsk
8601 ! & data,imax,jmax,abs(dlon),abs(dlat),lmask,rslmsk
8602 !cggg &, gaus,blno, blto, kgds(1))
8603 &, gaus,blno, blto, kgds(1), kpds(4), lbms)
8604
8605 ! write(6,*) ' kpds5=',kpds5,' lmask=',lmask
8606 !
8607 inttyp = 0
8608 if(kpds5.eq.225) inttyp = 1
8609 if(kpds5.eq.230) inttyp = 1
8610 if(kpds5.eq.66) inttyp = 1
8611 if(inttyp.eq.1) print *, ' nearest grid point used'
8612 !
8613 call la2ga(data,imax,jmax,rlngrb,rltgrb,wlon,rnlat,inttyp,
8614 & gdata,len,lmask,rslmsk,slmask
8615 &, outlat, outlon, me)
8616 !
8617 deallocate (rlngrb, stat=iret)
8618 deallocate (rltgrb, stat=iret)
8619 deallocate (data, stat=iret)
8620 deallocate (rslmsk, stat=iret)
8621 call baclose(lugb,iret2)
8622 ! write(6,*) ' '
8623 deallocate(data8)
8624 return
8625 !
8626 100 continue
8627 iret=1
8628 do i=1,len
8629 gdata(i) = -999.
8630 enddo
8631 !
8632 call baclose(lugb,iret2)
8633 !
8634 deallocate(data8)
8635 return
8636 end subroutine fixrda
8637 subroutine snodpth2(glacir,snwmax,snoanl, len, me)
8638 use machine , only : kind_io8,kind_io4
8639 implicit none
8640 integer i,me,len
8641 real (kind=kind_io8) snwmax
8642 !
8643 real (kind=kind_io8) snoanl(len), glacir(len)
8644 !
8645 if (me .eq. 0) write(6,*) 'snodpth2'
8646 !
8647 do i=1,len
8648 !
8649 ! if glacial points has snow in climatology, set sno to snomax
8650 !
8651 if(glacir(i).ne.0..and.snoanl(i).lt.snwmax*0.5) then
8652 snoanl(i) = snwmax + snoanl(i)
8653 endif
8654 !
8655 enddo
8656 return
8657 end
8658